├── .github └── workflows │ └── ci.yml ├── .gitignore ├── .ocamlformat ├── CHANGES.md ├── LICENSE ├── README.md ├── compile_commands.json ├── dune-project ├── example ├── dune ├── oneshot_timer.ml └── timer.ml ├── kqueue.opam ├── kqueue.opam.template ├── lib ├── bigstring.ml ├── bigstring.mli ├── config │ ├── config.ml │ └── dune ├── dune ├── kqueue.ml ├── kqueue.mli ├── kqueue_intf.ml └── kqueue_stubs.c └── test ├── dune └── kqueue_test.ml /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: Test kqueue-ml 2 | on: 3 | workflow_dispatch: 4 | push: 5 | branches: 6 | - main 7 | pull_request: 8 | branches: 9 | - main 10 | jobs: 11 | build: 12 | name: Build 13 | strategy: 14 | fail-fast: false 15 | matrix: 16 | ocaml-version: 17 | - 4.13.x 18 | os: 19 | - macos-latest 20 | - ubuntu-latest 21 | - windows-latest 22 | runs-on: ${{ matrix.os }} 23 | steps: 24 | - uses: actions/checkout@v2 25 | - uses: ocaml/setup-ocaml@v2 26 | with: 27 | ocaml-compiler: ${{ matrix.ocaml-version }} 28 | dune-cache: ${{ matrix.os != 'macos-latest' }} 29 | - name: Install dependencies 30 | run: | 31 | opam pin add kqueue.dev -n . 32 | opam install -t . --deps-only 33 | - name: Build 34 | run: | 35 | opam exec -- dune build 36 | - name: Test 37 | run: | 38 | opam exec -- dune runtest 39 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.merlin 2 | *.install 3 | _build 4 | _opam 5 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.24.1 2 | profile=janestreet 3 | parse-docstrings = true 4 | wrap-comments = true 5 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | # 0.4.0 2 | 3 | * Use conditional compilation to avoid using NOTE_OOB, NOTE_SIGNAL on FreeBSD (#18, @DavidAlphaFox) 4 | * Disable EVFILT_EXCEPT on OpenBSD (#18, @DavidAlphaFox) 5 | 6 | # 0.3.0 7 | 8 | * Support EVFILT_USER 9 | 10 | # 0.2.0 11 | 12 | * Remove the use of ctypes 13 | * Limit support to 64 bit systems 14 | * Add pre-defined constants for filter flags 15 | 16 | # 0.1.0 17 | 18 | * Initial version of kqueue-ml 19 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2020, Anurag Soni 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | 1. Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | 2. Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | 3. Neither the name of the copyright holder nor the names of its 17 | contributors may be used to endorse or promote products derived from 18 | this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Kqueue 2 | 3 | Low level OCaml bindings for [kqueue](https://en.wikipedia.org/wiki/Kqueue). 4 | 5 | ### Documentation 6 | 7 | Kqueue-ml's api is a minimal wrapper around kqueue so it is recommended to consult with kqueue manpages for freebsd, openbsd, netbsd, macOS for reference. 8 | 9 | **Caveat**: This is mostly tested on macOS. Please open issues for any problems noticed on other BSD systems. 10 | -------------------------------------------------------------------------------- /compile_commands.json: -------------------------------------------------------------------------------- 1 | [ 2 | { 3 | "arguments": [ 4 | "/usr/bin/cc", 5 | "-iquote", 6 | ".", 7 | "-O2", 8 | "-fno-strict-aliasing", 9 | "-fwrapv", 10 | "-pthread", 11 | "-D_FILE_OFFSET_BITS=64", 12 | "-O2", 13 | "-fno-strict-aliasing", 14 | "-fwrapv", 15 | "-pthread", 16 | "-g", 17 | "-I", 18 | "/Users/anuragsoni/.opam/default/lib/ocaml", 19 | "-I", 20 | "/Users/anuragsoni/.opam/default/lib/ocaml/unix", 21 | "-o", 22 | "kqueue_stubs.o", 23 | "-c", 24 | "kqueue_stubs.c" 25 | ], 26 | "directory": "/Users/anuragsoni/Code/OCaml/kqueue-ml/_build/default/lib", 27 | "file": "lib/kqueue_stubs.c" 28 | } 29 | ] -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.9) 2 | 3 | (name kqueue) 4 | 5 | (generate_opam_files true) 6 | 7 | (source 8 | (github anuragsoni/kqueue-ml)) 9 | 10 | (authors "Anurag Soni") 11 | 12 | (maintainers "Anurag Soni ") 13 | 14 | (documentation https://anuragsoni.github.io/kqueue-ml) 15 | 16 | (license BSD-3-clause) 17 | 18 | (package 19 | (name kqueue) 20 | (synopsis "OCaml bindings for kqueue event notification interface") 21 | (tags (kqueue)) 22 | (depends 23 | ppx_optcomp 24 | (ppx_expect :with-test) 25 | (ocaml 26 | (>= 4.12)))) 27 | -------------------------------------------------------------------------------- /example/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names timer oneshot_timer) 3 | (libraries kqueue)) 4 | -------------------------------------------------------------------------------- /example/oneshot_timer.ml: -------------------------------------------------------------------------------- 1 | let get_time () = 2 | let ic = Unix.open_process_in "date" in 3 | Fun.protect 4 | (fun () -> input_line ic) 5 | ~finally:(fun () -> Unix.close_process_in ic |> ignore) 6 | ;; 7 | 8 | let make_ev event ident time = 9 | let open Kqueue.Event_list in 10 | Event.set_ident event ident; 11 | Event.set_filter event Kqueue.Filter.timer; 12 | Event.set_flags event Kqueue.Flag.(add + oneshot); 13 | Event.set_fflags event Kqueue.Note.seconds; 14 | Event.set_data event time; 15 | Event.set_udata event 0 16 | ;; 17 | 18 | let process_event event = 19 | let open Kqueue.Event_list in 20 | let flags = Event.get_flags event in 21 | let data = Event.get_data event in 22 | if Kqueue.Flag.intersect flags Kqueue.Flag.error 23 | then ( 24 | let msg = Printf.sprintf "Error event received: %d" data in 25 | raise (Failure msg)); 26 | let filter = Event.get_filter event in 27 | if filter = Kqueue.Filter.timer 28 | then 29 | Printf.printf 30 | "%s : Timer event received for ident: %d, data: %d\n" 31 | (get_time ()) 32 | (Event.get_ident event) 33 | data 34 | else Format.printf "Unknown event received: %a\n" Kqueue.Filter.pp filter 35 | ;; 36 | 37 | let run () = 38 | let k = Kqueue.create () in 39 | for i = 1 to 5 do 40 | let changelist = Kqueue.Event_list.create 1 in 41 | let event = Kqueue.Event_list.get changelist 0 in 42 | make_ev event i 1; 43 | let n = 44 | Kqueue.kevent 45 | k 46 | ~changelist 47 | ~eventlist:Kqueue.Event_list.null 48 | Kqueue.Timeout.immediate 49 | in 50 | assert (n = 0); 51 | let eventlist = Kqueue.Event_list.create 1 in 52 | let n = 53 | Kqueue.kevent k ~changelist:Kqueue.Event_list.null ~eventlist Kqueue.Timeout.never 54 | in 55 | assert (n = 1); 56 | process_event (Kqueue.Event_list.get eventlist 0); 57 | flush stdout 58 | done 59 | ;; 60 | 61 | let () = run () 62 | -------------------------------------------------------------------------------- /example/timer.ml: -------------------------------------------------------------------------------- 1 | let get_time () = 2 | let ic = Unix.open_process_in "date" in 3 | Fun.protect 4 | (fun () -> input_line ic) 5 | ~finally:(fun () -> Unix.close_process_in ic |> ignore) 6 | ;; 7 | 8 | let process_event event = 9 | let open Kqueue.Event_list in 10 | let flag = Event.get_flags event in 11 | let data = Event.get_data event in 12 | if Kqueue.Flag.(intersect flag error) 13 | then ( 14 | let msg = Printf.sprintf "Error event received: %d" data in 15 | failwith msg); 16 | let filter = Event.get_filter event in 17 | if Kqueue.Filter.(filter = timer) 18 | then 19 | Printf.printf 20 | "%s : Timer event received for ident: %d\n" 21 | (get_time ()) 22 | (Event.get_ident event) 23 | else Format.printf "Unknown event received: %a\n" Kqueue.Filter.pp filter 24 | ;; 25 | 26 | let run k = 27 | print_endline "Processing events"; 28 | let eventlist = Kqueue.Event_list.create 5 in 29 | let rec loop () = 30 | let n = 31 | Kqueue.kevent 32 | k 33 | ~changelist:Kqueue.Event_list.null 34 | ~eventlist 35 | Kqueue.Timeout.immediate 36 | in 37 | assert (n >= 0); 38 | for i = 0 to n - 1 do 39 | let event = Kqueue.Event_list.get eventlist i in 40 | process_event event; 41 | flush stdout 42 | done; 43 | loop () 44 | in 45 | loop () 46 | ;; 47 | 48 | let make_ev event ident time = 49 | let open Kqueue.Event_list in 50 | Event.set_ident event ident; 51 | Event.set_filter event Kqueue.Filter.timer; 52 | Event.set_flags event Kqueue.Flag.add; 53 | Event.set_fflags event Kqueue.Note.seconds; 54 | Event.set_data event time; 55 | Event.set_udata event 0 56 | ;; 57 | 58 | let () = 59 | let k = Kqueue.create () in 60 | let changelist = Kqueue.Event_list.create 3 in 61 | make_ev (Kqueue.Event_list.get changelist 0) 1 1; 62 | make_ev (Kqueue.Event_list.get changelist 1) 2 5; 63 | make_ev (Kqueue.Event_list.get changelist 2) 3 10; 64 | let n = 65 | Kqueue.kevent k ~changelist ~eventlist:Kqueue.Event_list.null Kqueue.Timeout.never 66 | in 67 | assert (n = 0); 68 | run k 69 | ;; 70 | -------------------------------------------------------------------------------- /kqueue.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "OCaml bindings for kqueue event notification interface" 4 | maintainer: ["Anurag Soni "] 5 | authors: ["Anurag Soni"] 6 | license: "BSD-3-clause" 7 | tags: ["kqueue"] 8 | homepage: "https://github.com/anuragsoni/kqueue-ml" 9 | doc: "https://anuragsoni.github.io/kqueue-ml" 10 | bug-reports: "https://github.com/anuragsoni/kqueue-ml/issues" 11 | depends: [ 12 | "dune" {>= "2.9"} 13 | "ppx_optcomp" 14 | "ppx_expect" {with-test} 15 | "ocaml" {>= "4.12"} 16 | "odoc" {with-doc} 17 | ] 18 | build: [ 19 | ["dune" "subst"] {dev} 20 | [ 21 | "dune" 22 | "build" 23 | "-p" 24 | name 25 | "-j" 26 | jobs 27 | "--promote-install-files=false" 28 | "@install" 29 | "@runtest" {with-test} 30 | "@doc" {with-doc} 31 | ] 32 | ["dune" "install" "-p" name "--create-install-files" name] 33 | ] 34 | dev-repo: "git+https://github.com/anuragsoni/kqueue-ml.git" 35 | conflicts: [ 36 | "ppxlib" {< "0.14.0"} 37 | ] 38 | -------------------------------------------------------------------------------- /kqueue.opam.template: -------------------------------------------------------------------------------- 1 | conflicts: [ 2 | "ppxlib" {< "0.14.0"} 3 | ] 4 | -------------------------------------------------------------------------------- /lib/bigstring.ml: -------------------------------------------------------------------------------- 1 | type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t 2 | 3 | let create size = Bigarray.(Array1.create char c_layout size) 4 | 5 | external swap32 : int32 -> int32 = "%bswap_int32" 6 | external swap64 : int64 -> int64 = "%bswap_int64" 7 | external swap16 : int -> int = "%bswap16" 8 | external unsafe_get_int32 : t -> int -> int32 = "%caml_bigstring_get32u" 9 | external unsafe_set_int32 : t -> int -> int32 -> unit = "%caml_bigstring_set32u" 10 | external unsafe_get_int16 : t -> int -> int = "%caml_bigstring_get16u" 11 | external unsafe_set_int16 : t -> int -> int -> unit = "%caml_bigstring_set16u" 12 | external unsafe_get_int64 : t -> int -> int64 = "%caml_bigstring_get64u" 13 | external unsafe_set_int64 : t -> int -> int64 -> unit = "%caml_bigstring_set64u" 14 | 15 | let unsafe_get_int64_le_trunc_swap t ~pos = Int64.to_int (swap64 (unsafe_get_int64 t pos)) 16 | let unsafe_get_int64_le_trunc t ~pos = Int64.to_int (unsafe_get_int64 t pos) 17 | 18 | let unsafe_get_int64_le_trunc = 19 | if Sys.big_endian then unsafe_get_int64_le_trunc_swap else unsafe_get_int64_le_trunc 20 | ;; 21 | 22 | let unsafe_set_int64_swap t ~pos v = unsafe_set_int64 t pos (swap64 (Int64.of_int v)) 23 | let unsafe_set_int64 t ~pos v = unsafe_set_int64 t pos (Int64.of_int v) 24 | 25 | let unsafe_set_int64_le = 26 | if Sys.big_endian then unsafe_set_int64_swap else unsafe_set_int64 27 | ;; 28 | 29 | let unsafe_get_int32_le_swap t ~pos = Int32.to_int (swap32 (unsafe_get_int32 t pos)) 30 | let unsafe_get_int32_le t ~pos = Int32.to_int (unsafe_get_int32 t pos) 31 | 32 | let unsafe_get_int32_le = 33 | if Sys.big_endian then unsafe_get_int32_le_swap else unsafe_get_int32_le 34 | ;; 35 | 36 | let unsafe_set_int32_le_swap t ~pos v = unsafe_set_int32 t pos (swap32 (Int32.of_int v)) 37 | let unsafe_set_int32_le t ~pos v = unsafe_set_int32 t pos (Int32.of_int v) 38 | 39 | let unsafe_set_int32_le = 40 | if Sys.big_endian then unsafe_set_int32_le_swap else unsafe_set_int32_le 41 | ;; 42 | 43 | let sign_extend_16 u = (u lsl (Sys.int_size - 16)) asr (Sys.int_size - 16) 44 | let unsafe_get_int16_le_swap t ~pos = sign_extend_16 (swap16 (unsafe_get_int16 t pos)) 45 | let unsafe_get_int16_le t ~pos = sign_extend_16 (unsafe_get_int16 t pos) 46 | 47 | let unsafe_get_int16_le = 48 | if Sys.big_endian then unsafe_get_int16_le_swap else unsafe_get_int16_le 49 | ;; 50 | 51 | let unsafe_set_int16_le_swap t ~pos v = unsafe_set_int16 t pos (swap16 v) 52 | let unsafe_set_int16_le t ~pos v = unsafe_set_int16 t pos v 53 | 54 | let unsafe_set_int16_le = 55 | if Sys.big_endian then unsafe_set_int16_le_swap else unsafe_set_int16_le 56 | ;; 57 | -------------------------------------------------------------------------------- /lib/bigstring.mli: -------------------------------------------------------------------------------- 1 | type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t 2 | 3 | val create : int -> t 4 | val unsafe_get_int64_le_trunc : t -> pos:int -> int 5 | val unsafe_set_int64_le : t -> pos:int -> int -> unit 6 | val unsafe_get_int32_le : t -> pos:int -> int 7 | val unsafe_set_int32_le : t -> pos:int -> int -> unit 8 | val unsafe_get_int16_le : t -> pos:int -> int 9 | val unsafe_set_int16_le : t -> pos:int -> int -> unit 10 | -------------------------------------------------------------------------------- /lib/config/config.ml: -------------------------------------------------------------------------------- 1 | module C = Configurator.V1 2 | module SMap = Map.Make (String) 3 | 4 | let kqueue_available vars = 5 | List.exists 6 | (fun (_, v) -> 7 | match v with 8 | | C.C_define.Value.Switch true -> true 9 | | _ -> false) 10 | vars 11 | ;; 12 | 13 | let () = 14 | C.main ~name:"kqueue.conf" (fun conf -> 15 | let system = 16 | C.C_define.import 17 | conf 18 | ~includes:[ "caml/config.h" ] 19 | [ "ARCH_SIXTYFOUR", C.C_define.Type.Switch ] 20 | in 21 | let evfilt_user_available kqueue_available = 22 | let var = "EVFILT_USER" in 23 | if kqueue_available 24 | then ( 25 | let check = C.C_define.import conf ~includes:[ "sys/event.h" ] [ var, Switch ] in 26 | List.assoc var check) 27 | else C.C_define.Value.Switch false 28 | in 29 | let operating_systems = 30 | C.C_define.import 31 | conf 32 | ~includes:[] 33 | [ "__APPLE__", C.C_define.Type.Switch 34 | ; "__FreeBSD__", C.C_define.Type.Switch 35 | ; "__OpenBSD__", C.C_define.Type.Switch 36 | ; "__DragonFly__", C.C_define.Type.Switch 37 | ; "__NetBSD__", C.C_define.Type.Switch 38 | ] 39 | in 40 | let is_kqueue_available = kqueue_available operating_systems in 41 | let vars = 42 | [ "KQUEUE_AVAILABLE", C.C_define.Value.Switch is_kqueue_available 43 | ; "FREEBSD", List.assoc "__FreeBSD__" operating_systems 44 | ; "OPENBSD", List.assoc "__OpenBSD__" operating_systems 45 | ; "DRAGONFLY", List.assoc "__DragonFly__" operating_systems 46 | ; "NETBSD", List.assoc "__NetBSD__" operating_systems 47 | ; "KQUEUE_ML_ARCH_SIXTYFOUR", List.assoc "ARCH_SIXTYFOUR" system 48 | ; "EVFILT_USER_AVAILABLE", evfilt_user_available is_kqueue_available 49 | ] 50 | in 51 | C.C_define.gen_header_file conf ~fname:"config.h" vars) 52 | ;; 53 | -------------------------------------------------------------------------------- /lib/config/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name config) 3 | (libraries dune-configurator)) 4 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name kqueue) 3 | (public_name kqueue) 4 | (foreign_stubs 5 | (language c) 6 | (names kqueue_stubs)) 7 | (preprocessor_deps config.h) 8 | (preprocess 9 | (pps ppx_optcomp)) 10 | (libraries unix)) 11 | 12 | (rule 13 | (targets config.h) 14 | (action 15 | (run ./config/config.exe))) 16 | -------------------------------------------------------------------------------- /lib/kqueue.ml: -------------------------------------------------------------------------------- 1 | [%%import "config.h"] 2 | 3 | module Null = struct 4 | type t 5 | 6 | let available = false 7 | 8 | module Timeout = struct 9 | type t = [ `Not_implemented ] 10 | 11 | let never = `Not_implemented 12 | let immediate = `Not_implemented 13 | let of_ns _ = assert false 14 | end 15 | 16 | module Util = struct 17 | let file_descr_to_int : Unix.file_descr -> int = fun _ -> assert false 18 | let file_descr_of_int : int -> Unix.file_descr = fun _ -> assert false 19 | end 20 | 21 | module Note = struct 22 | type t = [ `Not_implemented ] 23 | 24 | let equal _ _ = assert false 25 | let ( = ) = equal 26 | let seconds = `Not_implemented 27 | let empty = `Not_implemented 28 | let useconds = `Not_implemented 29 | let nseconds = `Not_implemented 30 | let lowat = `Not_implemented 31 | [%%ifndef FREEBSD] 32 | let oob = `Not_implemented 33 | [%%endif] 34 | let delete = `Not_implemented 35 | let write = `Not_implemented 36 | let extend = `Not_implemented 37 | let attrib = `Not_implemented 38 | let link = `Not_implemented 39 | let rename = `Not_implemented 40 | let revoke = `Not_implemented 41 | let exit = `Not_implemented 42 | let fork = `Not_implemented 43 | let exec = `Not_implemented 44 | [%%ifndef FREEBSD] 45 | let signal = `Not_implemented 46 | [%%endif] 47 | 48 | [%%if defined EVFILT_USER_AVAILABLE] 49 | 50 | let ffnop = `Not_implemented 51 | let ffand = `Not_implemented 52 | let ffor = `Not_implemented 53 | let ffcopy = `Not_implemented 54 | let ffctrlmask = `Not_implemented 55 | let fflagsmask = `Not_implemented 56 | let trigger = `Not_implemented 57 | 58 | [%%endif] 59 | end 60 | 61 | module Filter = struct 62 | type t = [ `Not_implemented ] 63 | 64 | let pp _ _ = assert false 65 | let equal _ _ = assert false 66 | let ( = ) = equal 67 | let read = `Not_implemented 68 | let write = `Not_implemented 69 | let timer = `Not_implemented 70 | let vnode = `Not_implemented 71 | let proc = `Not_implemented 72 | 73 | [%%if defined OPENBSD] 74 | let except = `Not_implemented 75 | [%%endif] 76 | 77 | [%%if defined EVFILT_USER_AVAILABLE] 78 | 79 | let user = `Not_implemented 80 | 81 | [%%endif] 82 | end 83 | 84 | module Flag = struct 85 | type t = [ `Not_implemented ] 86 | 87 | let pp _ _ = assert false 88 | let equal _ _ = assert false 89 | let ( = ) = equal 90 | let ( + ) _ _ = assert false 91 | let intersect _ _ = assert false 92 | let receipt = `Not_implemented 93 | let add = `Not_implemented 94 | let enable = `Not_implemented 95 | let disable = `Not_implemented 96 | let delete = `Not_implemented 97 | let oneshot = `Not_implemented 98 | let clear = `Not_implemented 99 | let eof = `Not_implemented 100 | let error = `Not_implemented 101 | end 102 | 103 | module Event_list = struct 104 | type t = [ `Not_implemented ] 105 | 106 | let null = `Not_implemented 107 | let create _ = assert false 108 | 109 | module Event = struct 110 | type t = [ `Not_implemented ] 111 | 112 | let get_ident _ = assert false 113 | let set_ident _ _ = assert false 114 | let get_filter _ = assert false 115 | let set_filter _ _ = assert false 116 | let get_flags _ = assert false 117 | let set_flags _ _ = assert false 118 | let get_fflags _ = assert false 119 | let set_fflags _ _ = assert false 120 | let get_data _ = assert false 121 | let set_data _ _ = assert false 122 | let get_udata _ = assert false 123 | let set_udata _ _ = assert false 124 | end 125 | 126 | let get _ _ = assert false 127 | end 128 | 129 | let create () = assert false 130 | let kevent _ ~changelist:_ ~eventlist:_ _ = assert false 131 | let close _ = assert false 132 | end 133 | 134 | module _ : Kqueue_intf.S = struct 135 | include Null 136 | end 137 | 138 | [%%if defined KQUEUE_AVAILABLE && defined KQUEUE_ML_ARCH_SIXTYFOUR] 139 | 140 | module Util = struct 141 | let file_descr_to_int : Unix.file_descr -> int = Obj.magic 142 | let file_descr_of_int : int -> Unix.file_descr = Obj.magic 143 | end 144 | 145 | module Ffi = struct 146 | external kqueue : unit -> Unix.file_descr = "kqueue_ml_kqueue_create" 147 | 148 | external kevent 149 | : Unix.file_descr 150 | -> Bigstring.t 151 | -> Bigstring.t 152 | -> int64 153 | -> int 154 | = "kqueue_ml_kevent" 155 | end 156 | 157 | module Note = struct 158 | type t = int 159 | 160 | let equal = Int.equal 161 | let ( = ) = equal 162 | let empty = 0 163 | 164 | external seconds : unit -> int = "kqueue_note_seconds" 165 | 166 | let seconds = seconds () 167 | 168 | external useconds : unit -> int = "kqueue_note_useconds" 169 | 170 | let useconds = useconds () 171 | 172 | external nseconds : unit -> int = "kqueue_note_nseconds" 173 | 174 | let nseconds = nseconds () 175 | 176 | external lowat : unit -> int = "kqueue_note_lowat" 177 | 178 | let lowat = lowat () 179 | 180 | [%%ifndef FREEBSD] 181 | external oob : unit -> int = "kqueue_note_oob" 182 | 183 | let oob = oob () 184 | [%%endif] 185 | external delete : unit -> int = "kqueue_note_delete" 186 | 187 | let delete = delete () 188 | 189 | external write : unit -> int = "kqueue_note_write" 190 | 191 | let write = write () 192 | 193 | external extend : unit -> int = "kqueue_note_extend" 194 | 195 | let extend = extend () 196 | 197 | external attrib : unit -> int = "kqueue_note_attrib" 198 | 199 | let attrib = attrib () 200 | 201 | external link : unit -> int = "kqueue_note_link" 202 | 203 | let link = link () 204 | 205 | external rename : unit -> int = "kqueue_note_rename" 206 | 207 | let rename = rename () 208 | 209 | external revoke : unit -> int = "kqueue_note_revoke" 210 | 211 | let revoke = revoke () 212 | 213 | external exit : unit -> int = "kqueue_note_exit" 214 | 215 | let exit = exit () 216 | 217 | external fork : unit -> int = "kqueue_note_fork" 218 | 219 | let fork = fork () 220 | 221 | external exec : unit -> int = "kqueue_note_exec" 222 | 223 | let exec = exec () 224 | [%%ifndef FREEBSD] 225 | external signal : unit -> int = "kqueue_note_signal" 226 | 227 | let signal = signal () 228 | [%%endif] 229 | [%%if defined EVFILT_USER_AVAILABLE] 230 | 231 | external ffnop : unit -> int = "kqueue_note_ffnop" 232 | 233 | let ffnop = ffnop () 234 | 235 | external ffand : unit -> int = "kqueue_note_ffand" 236 | 237 | let ffand = ffand () 238 | 239 | external ffor : unit -> int = "kqueue_note_ffor" 240 | 241 | let ffor = ffor () 242 | 243 | external ffcopy : unit -> int = "kqueue_note_ffcopy" 244 | 245 | let ffcopy = ffcopy () 246 | 247 | external ffctrlmask : unit -> int = "kqueue_note_ffctrlmask" 248 | 249 | let ffctrlmask = ffctrlmask () 250 | 251 | external fflagsmask : unit -> int = "kqueue_note_fflagsmask" 252 | 253 | let fflagsmask = fflagsmask () 254 | 255 | external trigger : unit -> int = "kqueue_note_trigger" 256 | 257 | let trigger = trigger () 258 | 259 | [%%endif] 260 | end 261 | 262 | module Flag = struct 263 | type t = int 264 | 265 | let equal = Int.equal 266 | let ( = ) = equal 267 | let ( + ) = ( lor ) 268 | let intersect t1 t2 = t1 land t2 <> 0 269 | let is_subset t ~of_:flags = t = t land flags 270 | 271 | external add : unit -> int = "kqueue_flag_ev_add" 272 | 273 | let add = add () 274 | 275 | external receipt : unit -> int = "kqueue_flag_ev_receipt" 276 | 277 | let receipt = receipt () 278 | 279 | external enable : unit -> int = "kqueue_flag_ev_enable" 280 | 281 | let enable = enable () 282 | 283 | external disable : unit -> int = "kqueue_flag_ev_disable" 284 | 285 | let disable = disable () 286 | 287 | external delete : unit -> int = "kqueue_flag_ev_delete" 288 | 289 | let delete = delete () 290 | 291 | external oneshot : unit -> int = "kqueue_flag_ev_oneshot" 292 | 293 | let oneshot = oneshot () 294 | 295 | external clear : unit -> int = "kqueue_flag_ev_clear" 296 | 297 | let clear = clear () 298 | 299 | external eof : unit -> int = "kqueue_flag_ev_eof" 300 | 301 | let eof = eof () 302 | 303 | external error : unit -> int = "kqueue_flag_ev_error" 304 | 305 | let error = error () 306 | 307 | let known = 308 | [ add, "EV_ADD" 309 | ; enable, "EV_ENABLE" 310 | ; disable, "EV_DISABLE" 311 | ; delete, "EV_DELETE" 312 | ; oneshot, "EV_ONESHOT" 313 | ; clear, "EV_CLEAR" 314 | ; eof, "EV_EOF" 315 | ; error, "EV_ERROR" 316 | ] 317 | ;; 318 | 319 | let pp fmt t = 320 | let known_flags = 321 | List.filter_map 322 | (fun (k, label) -> if is_subset k ~of_:t then Some label else None) 323 | known 324 | in 325 | Format.pp_print_list 326 | ~pp_sep:(fun fmt () -> Format.fprintf fmt ", ") 327 | Format.pp_print_string 328 | fmt 329 | known_flags 330 | ;; 331 | end 332 | 333 | module Filter = struct 334 | type t = int 335 | 336 | let equal a b = Int.equal a b 337 | let ( = ) = equal 338 | 339 | [%%if defined EVFILT_USER_AVAILABLE] 340 | 341 | external user : unit -> int = "kqueue_filter_evfilt_user" 342 | 343 | let user = user () 344 | 345 | [%%endif] 346 | 347 | external read : unit -> int = "kqueue_filter_evfilt_read" 348 | 349 | let read = read () 350 | 351 | external write : unit -> int = "kqueue_filter_evfilt_write" 352 | 353 | let write = write () 354 | 355 | external timer : unit -> int = "kqueue_filter_evfilt_timer" 356 | 357 | let timer = timer () 358 | 359 | external vnode : unit -> int = "kqueue_filter_evfilt_vnode" 360 | 361 | let vnode = vnode () 362 | 363 | external proc : unit -> int = "kqueue_filter_evfilt_proc" 364 | 365 | let proc = proc () 366 | 367 | [%%if defined OPENBSD] 368 | external except: unit -> int = "kqueue_filter_evilt_except" 369 | 370 | let except = except() 371 | [%%endif] 372 | 373 | let known_filters = 374 | [ read, "EVFILT_READ" 375 | ; write, "EVFILT_WRITE" 376 | ; timer, "EVFILT_TIMER" 377 | ; vnode, "EVFILT_VNODE" 378 | ] 379 | ;; 380 | 381 | [%%if defined OPENBSD] 382 | let known_filters = known_filters @ [ except, "EVFILT_EXCEPT"] 383 | [%%endif] 384 | 385 | [%%if defined EVFILT_USER_AVAILABLE] 386 | 387 | let known_filters = known_filters @ [ user, "EVFILT_USER" ] 388 | 389 | [%%endif] 390 | 391 | let to_string t = 392 | let rec loop filters = 393 | match filters with 394 | | [] -> Printf.sprintf "Unknown (%d)" t 395 | | (filter, label) :: _ when filter = t -> label 396 | | _ :: xs -> loop xs 397 | in 398 | loop known_filters 399 | ;; 400 | 401 | let pp fmt t = Format.fprintf fmt "%a" Format.pp_print_string (to_string t) 402 | end 403 | 404 | module Kevent = struct 405 | external sizeof : unit -> int = "kqueue_ml_kevent_sizeof" 406 | external event_ident_offset : unit -> int = "kqueue_ml_kevent_offset_event_fd" 407 | 408 | let event_ident_offset = event_ident_offset () 409 | 410 | external event_filter_offset : unit -> int = "kqueue_ml_kevent_offset_filter" 411 | 412 | let event_filter_offset = event_filter_offset () 413 | 414 | external event_flags_offset : unit -> int = "kqueue_ml_kevent_offset_flags" 415 | 416 | let event_flags_offset = event_flags_offset () 417 | 418 | external event_fflags_offset : unit -> int = "kqueue_ml_kevent_offset_fflags" 419 | 420 | let event_fflags_offset = event_fflags_offset () 421 | 422 | external event_data_offset : unit -> int = "kqueue_ml_kevent_offset_data" 423 | 424 | let event_data_offset = event_data_offset () 425 | 426 | external event_udata_offset : unit -> int = "kqueue_ml_kevent_offset_udata" 427 | 428 | let event_udata_offset = event_udata_offset () 429 | let sizeof = sizeof () 430 | 431 | let read_ident_at buf idx = 432 | Bigstring.unsafe_get_int64_le_trunc buf ~pos:((idx * sizeof) + event_ident_offset) 433 | ;; 434 | 435 | let write_ident_at buf idx ident = 436 | Bigstring.unsafe_set_int64_le buf ~pos:((idx * sizeof) + event_ident_offset) ident 437 | ;; 438 | 439 | let read_filter_at buf idx = 440 | Bigstring.unsafe_get_int16_le buf ~pos:((idx * sizeof) + event_filter_offset) 441 | ;; 442 | 443 | let write_filter_at buf idx filter = 444 | Bigstring.unsafe_set_int16_le buf ~pos:((idx * sizeof) + event_filter_offset) filter 445 | ;; 446 | 447 | let read_flags_at buf idx = 448 | Bigstring.unsafe_get_int16_le buf ~pos:((idx * sizeof) + event_flags_offset) 449 | ;; 450 | 451 | let write_flags_at buf idx flags = 452 | Bigstring.unsafe_set_int16_le buf ~pos:((idx * sizeof) + event_flags_offset) flags 453 | ;; 454 | 455 | let read_fflags_at buf idx = 456 | Bigstring.unsafe_get_int32_le buf ~pos:((idx * sizeof) + event_fflags_offset) 457 | ;; 458 | 459 | let write_fflags_at buf idx fflags = 460 | Bigstring.unsafe_set_int32_le buf ~pos:((idx * sizeof) + event_fflags_offset) fflags 461 | ;; 462 | 463 | let read_data_at buf idx = 464 | Bigstring.unsafe_get_int64_le_trunc buf ~pos:((idx * sizeof) + event_data_offset) 465 | ;; 466 | 467 | let write_data_at buf idx data = 468 | Bigstring.unsafe_set_int64_le buf ~pos:((idx * sizeof) + event_data_offset) data 469 | ;; 470 | 471 | let read_udata_at buf idx = 472 | Bigstring.unsafe_get_int64_le_trunc buf ~pos:((idx * sizeof) + event_udata_offset) 473 | ;; 474 | 475 | let write_udata_at buf idx data = 476 | Bigstring.unsafe_set_int64_le buf ~pos:((idx * sizeof) + event_udata_offset) data 477 | ;; 478 | end 479 | 480 | module Event_list = struct 481 | type t = Bigstring.t 482 | 483 | let null = Bigstring.create 0 484 | 485 | module Event = struct 486 | type t = 487 | { buf : Bigstring.t 488 | ; idx : int 489 | } 490 | 491 | let get_ident t = Kevent.read_ident_at t.buf t.idx 492 | let set_ident t ident = Kevent.write_ident_at t.buf t.idx ident 493 | let get_filter t = Kevent.read_filter_at t.buf t.idx 494 | let set_filter t filter = Kevent.write_filter_at t.buf t.idx filter 495 | let get_flags t = Kevent.read_flags_at t.buf t.idx 496 | let set_flags t flags = Kevent.write_flags_at t.buf t.idx flags 497 | let get_fflags t = Kevent.read_fflags_at t.buf t.idx 498 | let set_fflags t fflags = Kevent.write_fflags_at t.buf t.idx fflags 499 | let get_data t = Kevent.read_data_at t.buf t.idx 500 | let set_data t data = Kevent.write_data_at t.buf t.idx data 501 | let get_udata t = Kevent.read_udata_at t.buf t.idx 502 | let set_udata t udata = Kevent.write_udata_at t.buf t.idx udata 503 | end 504 | 505 | let create size = 506 | if size < 1 then invalid_arg "Kqueue.create: changelist_size cannot be less than 1"; 507 | Bigstring.create (Kevent.sizeof * size) 508 | ;; 509 | 510 | let get t idx = { Event.buf = t; idx } 511 | end 512 | 513 | module Timeout = struct 514 | type t = int64 515 | 516 | let never = -1L 517 | let immediate = 0L 518 | 519 | let of_ns x = 520 | if x < 0L then invalid_arg "Timeout cannot be negative"; 521 | x 522 | ;; 523 | end 524 | 525 | type t = 526 | { kqueue_fd : Unix.file_descr 527 | ; mutable closed : bool 528 | } 529 | 530 | let ensure_open t = if t.closed then failwith "Attempting to use a closed kqueue" 531 | let create () = { kqueue_fd = Ffi.kqueue (); closed = false } 532 | 533 | let kevent t ~changelist ~eventlist timeout = 534 | ensure_open t; 535 | Ffi.kevent t.kqueue_fd changelist eventlist timeout 536 | ;; 537 | 538 | let close t = 539 | if not t.closed 540 | then ( 541 | t.closed <- true; 542 | Unix.close t.kqueue_fd) 543 | ;; 544 | 545 | let available = true 546 | 547 | [%%else] 548 | 549 | include Null 550 | 551 | [%%endif] 552 | -------------------------------------------------------------------------------- /lib/kqueue.mli: -------------------------------------------------------------------------------- 1 | (** kqueue(): Kqueue is a scalable event notification interface available on macOS and 2 | various BSD systems (FreeBSD, OpenBSD, etc). 3 | 4 | Consult the kqueue manpages to see the full list of functionality: 5 | 6 | - {{:https://www.freebsd.org/cgi/man.cgi?kqueue} FreeBSD} 7 | - {{:https://man.openbsd.org/kqueue.2} OpenBSD} 8 | - {{:https://opensource.apple.com/source/xnu/xnu-792/bsd/man/man2/kqueue.2} macOS} *) 9 | include Kqueue_intf.S 10 | -------------------------------------------------------------------------------- /lib/kqueue_intf.ml: -------------------------------------------------------------------------------- 1 | [%%import "config.h"] 2 | 3 | module type S = sig 4 | type t 5 | 6 | module Timeout : sig 7 | (** [Kqueue.Timeout.t] is the timespan in nanoseconds that is used to represent the 8 | maximum amount of time the kevent call should wait for an event. *) 9 | type t 10 | 11 | (** [never] results in the kevent call to wait indefinitely for a new event. 12 | 13 | {e Note:} Unlike [Unix.select], if the user calls kevent with an empty eventlist, 14 | the kevent call returns immediately event when a timeout value of [never] is used. *) 15 | val never : t 16 | 17 | (** [immediate] effects a poll, and the kevent call will return immediately, without 18 | waiting for new events if none are available at the time of the call. *) 19 | val immediate : t 20 | 21 | (** [of_ns] creates a new timeout from nanoseconds. *) 22 | val of_ns : int64 -> t 23 | end 24 | 25 | module Note : sig 26 | (** [Kqueue.Note.t] represents the kqueue filter specific flags. These are used in 27 | combination with the data field to augment the behavior of kqueue event filters. 28 | 29 | Consult the kqueue manpages to see what the various Note values represent. 30 | 31 | - {{:https://www.freebsd.org/cgi/man.cgi?kqueue} FreeBSD} 32 | - {{:https://man.openbsd.org/kqueue.2} OpenBSD}*) 33 | type t 34 | 35 | val equal : t -> t -> bool 36 | val ( = ) : t -> t -> bool 37 | val empty : t 38 | val seconds : t 39 | val useconds : t 40 | val nseconds : t 41 | val lowat : t 42 | [%%ifndef FREEBSD] 43 | val oob : t 44 | [%%endif] 45 | val delete : t 46 | val write : t 47 | val extend : t 48 | val attrib : t 49 | val link : t 50 | val rename : t 51 | val revoke : t 52 | val exit : t 53 | val fork : t 54 | val exec : t 55 | [%%ifndef FREEBSD] 56 | val signal : t 57 | [%%endif] 58 | 59 | [%%if defined EVFILT_USER_AVAILABLE] 60 | 61 | val ffnop : t 62 | val ffand : t 63 | val ffor : t 64 | val ffcopy : t 65 | val ffctrlmask : t 66 | val fflagsmask : t 67 | val trigger : t 68 | 69 | [%%endif] 70 | end 71 | 72 | module Filter : sig 73 | (** [Kqueue.Filter.t] represents the kernel filter used to process an event. *) 74 | type t 75 | 76 | val pp : Format.formatter -> t -> unit 77 | val equal : t -> t -> bool 78 | val ( = ) : t -> t -> bool 79 | val read : t 80 | val write : t 81 | val timer : t 82 | val vnode : t 83 | val proc : t 84 | [%%if defined OPENBSD] 85 | val except : t 86 | [%%endif] 87 | [%%if defined EVFILT_USER_AVAILABLE] 88 | 89 | val user : t 90 | 91 | [%%endif] 92 | end 93 | 94 | module Flag : sig 95 | (** [Kqueue.Flag.t] is a set of flags that are used to indicate which actions should 96 | be performed for an event. *) 97 | type t 98 | 99 | val equal : t -> t -> bool 100 | val ( = ) : t -> t -> bool 101 | val pp : Format.formatter -> t -> unit 102 | val ( + ) : t -> t -> t 103 | val intersect : t -> t -> bool 104 | val receipt : t 105 | val add : t 106 | val enable : t 107 | val disable : t 108 | val delete : t 109 | val oneshot : t 110 | val clear : t 111 | val eof : t 112 | val error : t 113 | end 114 | 115 | module Event_list : sig 116 | (** [Kqueue.Event_list.t] represents a list of kevents that can be used to populate 117 | either the changelist or the eventlist for the kevent syscall. The intended usage 118 | is to allocate a list of events using [create], and then retrieve events at a 119 | particular index using [get idx], and then using the [Kqueue.Event_list.Event] 120 | module to read/write the varios fields that belong to a kevent. *) 121 | type t 122 | 123 | val null : t 124 | val create : int -> t 125 | 126 | module Event : sig 127 | type t 128 | 129 | val get_ident : t -> int 130 | val set_ident : t -> int -> unit 131 | val get_filter : t -> Filter.t 132 | val set_filter : t -> Filter.t -> unit 133 | val get_flags : t -> Flag.t 134 | val set_flags : t -> Flag.t -> unit 135 | val get_fflags : t -> Note.t 136 | val set_fflags : t -> Note.t -> unit 137 | val get_data : t -> int 138 | val set_data : t -> int -> unit 139 | val get_udata : t -> int 140 | val set_udata : t -> int -> unit 141 | end 142 | 143 | val get : t -> int -> Event.t 144 | end 145 | 146 | (** [create] creates a new kernel event queue. *) 147 | val create : unit -> t 148 | 149 | (** [kevent] is used to register new events, and fetch any ready events from the kernel 150 | queue. 151 | 152 | [changelist] is the list of new events to be submitted. 153 | 154 | [eventlist] is the container where the kernel queue fill fill any new events that 155 | are ready for the user. 156 | 157 | If [eventlist] is empty the kevent call will return immediately even if a non zero 158 | timeout is used. The response returns the count of new events returned by the kernel 159 | queue. *) 160 | val kevent : t -> changelist:Event_list.t -> eventlist:Event_list.t -> Timeout.t -> int 161 | 162 | (** [close] closes the kernel queue. *) 163 | val close : t -> unit 164 | 165 | module Util : sig 166 | (** [file_descr_to_int] will convert a [Unix.file_descr] to an integer. This is 167 | intended to be used to create an kevent ident when registering a file descriptor 168 | based kevent. *) 169 | val file_descr_to_int : Unix.file_descr -> int 170 | 171 | (** [file_descr_to_int] will convert an integer to a [Unix.file_descr]. *) 172 | val file_descr_of_int : int -> Unix.file_descr 173 | end 174 | 175 | (** [available] Indicates if the system where this library was built has kqueue 176 | available. *) 177 | val available : bool 178 | end 179 | -------------------------------------------------------------------------------- /lib/kqueue_stubs.c: -------------------------------------------------------------------------------- 1 | #include "config.h" 2 | 3 | #ifdef KQUEUE_AVAILABLE 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | #include 17 | #include 18 | #include 19 | #include 20 | 21 | #define Kqueue_constant(name, i) \ 22 | CAMLprim value name(value unit) { return Val_int(i); } 23 | 24 | CAMLprim value kqueue_ml_kqueue_create(value unit) { 25 | CAMLparam1(unit); 26 | int k; 27 | k = kqueue(); 28 | if (k == -1) 29 | uerror("kqueue", Nothing); 30 | fcntl(k, F_SETFD, FD_CLOEXEC); 31 | CAMLreturn(Val_long(k)); 32 | } 33 | 34 | CAMLprim value kqueue_ml_kevent_sizeof(value unit) { 35 | CAMLparam1(unit); 36 | CAMLreturn(Val_long(sizeof(struct kevent))); 37 | } 38 | 39 | CAMLprim value kqueue_ml_kevent_offset_event_fd(value unit) { 40 | CAMLparam1(unit); 41 | CAMLreturn(Val_int(offsetof(struct kevent, ident))); 42 | } 43 | 44 | CAMLprim value kqueue_ml_kevent_offset_filter(value unit) { 45 | CAMLparam1(unit); 46 | CAMLreturn(Val_int(offsetof(struct kevent, filter))); 47 | } 48 | 49 | CAMLprim value kqueue_ml_kevent_offset_flags(value unit) { 50 | CAMLparam1(unit); 51 | CAMLreturn(Val_int(offsetof(struct kevent, flags))); 52 | } 53 | 54 | CAMLprim value kqueue_ml_kevent_offset_fflags(value unit) { 55 | CAMLparam1(unit); 56 | CAMLreturn(Val_int(offsetof(struct kevent, fflags))); 57 | } 58 | 59 | CAMLprim value kqueue_ml_kevent_offset_data(value unit) { 60 | CAMLparam1(unit); 61 | CAMLreturn(Val_int(offsetof(struct kevent, data))); 62 | } 63 | 64 | CAMLprim value kqueue_ml_kevent_offset_udata(value unit) { 65 | CAMLparam1(unit); 66 | CAMLreturn(Val_int(offsetof(struct kevent, udata))); 67 | } 68 | 69 | CAMLprim value kqueue_ml_kevent(value kqueue_fd, value changelist, value eventlist, value timeout) { 70 | CAMLparam4(kqueue_fd, changelist, eventlist, timeout); 71 | struct kevent * changes; 72 | struct kevent * events; 73 | int ret, event_count, change_count; 74 | int64_t ns; 75 | ns = Int64_val(timeout); 76 | changes = (struct kevent *) Caml_ba_data_val(changelist); 77 | events = (struct kevent *) Caml_ba_data_val(eventlist); 78 | event_count = Caml_ba_array_val(eventlist)->dim[0] / sizeof (struct kevent); 79 | change_count = Caml_ba_array_val(changelist)->dim[0] / sizeof (struct kevent); 80 | if (ns == 0) { 81 | struct timespec t = { 0, 0 }; 82 | ret = kevent(Long_val(kqueue_fd), changes, change_count, events, event_count, &t); 83 | } else if (ns < 0) { 84 | caml_enter_blocking_section(); 85 | ret = kevent(Long_val(kqueue_fd), changes, change_count, events, event_count, NULL); 86 | caml_leave_blocking_section(); 87 | } else { 88 | struct timespec t; 89 | t.tv_sec = ns / 1000000000; 90 | t.tv_nsec = (ns % 1000000000); 91 | caml_enter_blocking_section(); 92 | ret = kevent(Long_val(kqueue_fd), changes, change_count, events, event_count, &t); 93 | caml_leave_blocking_section(); 94 | } 95 | if (ret == -1) 96 | uerror("kevent", Nothing); 97 | CAMLreturn(Val_long(ret)); 98 | } 99 | 100 | #ifdef EVFILT_USER_AVAILABLE 101 | Kqueue_constant(kqueue_filter_evfilt_user, EVFILT_USER) 102 | Kqueue_constant(kqueue_note_ffnop, NOTE_FFNOP) 103 | Kqueue_constant(kqueue_note_ffand, NOTE_FFAND) 104 | Kqueue_constant(kqueue_note_ffor, NOTE_FFOR) 105 | Kqueue_constant(kqueue_note_ffcopy, NOTE_FFCOPY) 106 | Kqueue_constant(kqueue_note_ffctrlmask, NOTE_FFCTRLMASK) 107 | Kqueue_constant(kqueue_note_fflagsmask, NOTE_FFLAGSMASK) 108 | Kqueue_constant(kqueue_note_trigger, NOTE_TRIGGER) 109 | #endif 110 | 111 | Kqueue_constant(kqueue_filter_evfilt_read, EVFILT_READ) 112 | Kqueue_constant(kqueue_filter_evfilt_write, EVFILT_WRITE) 113 | Kqueue_constant(kqueue_filter_evfilt_timer, EVFILT_TIMER) 114 | Kqueue_constant(kqueue_filter_evfilt_vnode, EVFILT_VNODE) 115 | Kqueue_constant(kqueue_filter_evfilt_proc, EVFILT_PROC) 116 | #ifdef __OpenBSD__ 117 | Kqueue_constant(kqueue_filter_evfilt_except, EVFILT_EXCEPT) 118 | #endif 119 | 120 | Kqueue_constant(kqueue_flag_ev_add, EV_ADD) 121 | Kqueue_constant(kqueue_flag_ev_receipt, EV_RECEIPT) 122 | Kqueue_constant(kqueue_flag_ev_enable, EV_ENABLE) 123 | Kqueue_constant(kqueue_flag_ev_disable, EV_DISABLE) 124 | Kqueue_constant(kqueue_flag_ev_delete, EV_DELETE) 125 | Kqueue_constant(kqueue_flag_ev_oneshot, EV_ONESHOT) 126 | Kqueue_constant(kqueue_flag_ev_clear, EV_CLEAR) 127 | Kqueue_constant(kqueue_flag_ev_eof, EV_EOF) 128 | Kqueue_constant(kqueue_flag_ev_error, EV_ERROR) 129 | Kqueue_constant(kqueue_note_seconds, NOTE_SECONDS) 130 | Kqueue_constant(kqueue_note_useconds, NOTE_USECONDS) 131 | Kqueue_constant(kqueue_note_nseconds, NOTE_NSECONDS) 132 | Kqueue_constant(kqueue_note_lowat, NOTE_LOWAT) 133 | #ifndef __FreeBSD__ 134 | Kqueue_constant(kqueue_note_oob, NOTE_OOB) 135 | #endif 136 | Kqueue_constant(kqueue_note_delete, NOTE_DELETE) 137 | Kqueue_constant(kqueue_note_write, NOTE_WRITE) 138 | Kqueue_constant(kqueue_note_extend, NOTE_EXTEND) 139 | Kqueue_constant(kqueue_note_attrib, NOTE_ATTRIB) 140 | Kqueue_constant(kqueue_note_link, NOTE_LINK) 141 | Kqueue_constant(kqueue_note_rename, NOTE_RENAME) 142 | Kqueue_constant(kqueue_note_revoke, NOTE_REVOKE) 143 | Kqueue_constant(kqueue_note_exit, NOTE_EXIT) 144 | Kqueue_constant(kqueue_note_fork, NOTE_FORK) 145 | Kqueue_constant(kqueue_note_exec, NOTE_EXEC) 146 | #ifndef __FreeBSD__ 147 | Kqueue_constant(kqueue_note_signal, NOTE_SIGNAL) 148 | #endif 149 | #else 150 | typedef int dummy_definition; 151 | #endif 152 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name kqueue_test) 3 | (inline_tests) 4 | (preprocessor_deps config.h) 5 | (preprocess 6 | (pps ppx_expect ppx_optcomp)) 7 | (libraries kqueue)) 8 | 9 | (rule 10 | (targets config.h) 11 | (action 12 | (run ../lib/config/config.exe))) 13 | -------------------------------------------------------------------------------- /test/kqueue_test.ml: -------------------------------------------------------------------------------- 1 | [%%import "config.h"] 2 | [%%if defined KQUEUE_AVAILABLE && defined KQUEUE_ML_ARCH_SIXTYFOUR] 3 | 4 | let%expect_test "kqueue available" = 5 | Printf.printf "Kqueue available: %b\n" Kqueue.available; 6 | [%expect {| Kqueue available: true |}] 7 | ;; 8 | 9 | let%expect_test "kqueue timer" = 10 | let make_ev event ident time = 11 | let open Kqueue.Event_list in 12 | Event.set_ident event ident; 13 | Event.set_filter event Kqueue.Filter.timer; 14 | Event.set_flags event Kqueue.Flag.(add + oneshot); 15 | Event.set_fflags event Kqueue.Note.nseconds; 16 | Event.set_data event time; 17 | Event.set_udata event 0 18 | in 19 | let k = Kqueue.create () in 20 | for i = 1 to 5 do 21 | let changelist = Kqueue.Event_list.create 1 in 22 | let event = Kqueue.Event_list.get changelist 0 in 23 | make_ev event i (i * 1_000_000); 24 | let n = 25 | Kqueue.kevent 26 | k 27 | ~changelist 28 | ~eventlist:Kqueue.Event_list.null 29 | Kqueue.Timeout.immediate 30 | in 31 | assert (n = 0); 32 | let eventlist = Kqueue.Event_list.create 1 in 33 | let n = 34 | Kqueue.kevent k ~changelist:Kqueue.Event_list.null ~eventlist Kqueue.Timeout.never 35 | in 36 | assert (n = 1); 37 | let event = Kqueue.Event_list.get eventlist 0 in 38 | Format.printf 39 | "Received %a event for ident: %d\n" 40 | Kqueue.Filter.pp 41 | (Kqueue.Event_list.Event.get_filter event) 42 | (Kqueue.Event_list.Event.get_ident event) 43 | done; 44 | [%expect 45 | {| 46 | Received EVFILT_TIMER event for ident: 1 47 | Received EVFILT_TIMER event for ident: 2 48 | Received EVFILT_TIMER event for ident: 3 49 | Received EVFILT_TIMER event for ident: 4 50 | Received EVFILT_TIMER event for ident: 5 |}] 51 | ;; 52 | 53 | [%%else] 54 | 55 | let%expect_test "kqueue unavailable" = 56 | Printf.printf "Kqueue available: %b\n" Kqueue.available; 57 | [%expect {| Kqueue available: false |}] 58 | ;; 59 | 60 | [%%endif] 61 | --------------------------------------------------------------------------------