My working unpac space for OCaml projects in development
Merge opam/patches/iomux
+874
+33
vendor/opam/iomux/.github/workflows/test.yml
+33
vendor/opam/iomux/.github/workflows/test.yml
···
1
+
name: Iomux
2
+
3
+
on: [push, pull_request]
4
+
5
+
jobs:
6
+
tests:
7
+
name: Tests
8
+
9
+
strategy:
10
+
fail-fast: false
11
+
matrix:
12
+
ocaml-version: ["5.3.0", "4.14.2"]
13
+
operating-system: [macos-latest, ubuntu-latest]
14
+
15
+
runs-on: ${{ matrix.operating-system }}
16
+
17
+
steps:
18
+
- name: Checkout code
19
+
uses: actions/checkout@v5
20
+
21
+
- name: Use OCaml ${{ matrix.ocaml-version }}
22
+
uses: ocaml/setup-ocaml@v3
23
+
with:
24
+
ocaml-compiler: ${{ matrix.ocaml-version }}
25
+
26
+
- name: Install dependencies
27
+
run: opam install . --deps-only --with-test
28
+
29
+
- name: Build
30
+
run: opam exec -- dune build
31
+
32
+
- name: Test
33
+
run: opam exec -- dune runtest
+8
vendor/opam/iomux/.gitignore
+8
vendor/opam/iomux/.gitignore
+24
vendor/opam/iomux/CHANGES.md
+24
vendor/opam/iomux/CHANGES.md
···
1
+
## v0.4 (2025-09-17)
2
+
3
+
* Clamp max open files to 2^19, as macOS sometimes returns
4
+
2^32-1 (#7 @avsm).
5
+
* Upgrade to dune 3.19 and move to ocaml-multicore organisation (@avsm).
6
+
7
+
## v0.3 (2023-03-10)
8
+
9
+
* Round timeouts up, not down in Poll.poll (spotted by @talex5)
10
+
* Properly guard negative indexes (spotted by @talex5)
11
+
* Use half the maximum fds for the leak test (@haesbaert)
12
+
13
+
## v0.2 (2023-02-27)
14
+
15
+
* Narrowed the type of `Util.fd_of_unix` (@reynir)
16
+
* Use older school uerror instead of `caml_uerror` (@reynir)
17
+
* Added `c_standard` to dune build flags (@reynir)
18
+
* Addded ppoll(2) discoverability and a mini compat layer (@haesbaert)
19
+
* Improved tests (@haesbaert)
20
+
* Re-added macos support (@haesbaert)
21
+
22
+
## v0.1 (2023-02-17)
23
+
24
+
* Initial release
+14
vendor/opam/iomux/LICENSE.md
+14
vendor/opam/iomux/LICENSE.md
···
1
+
Copyright (c) 2023 Christiano Haesbaert <haesbaert@haesbaert.org>
2
+
3
+
Permission to use, copy, modify, and distribute this software for any
4
+
purpose with or without fee is hereby granted, provided that the above
5
+
copyright notice and this permission notice appear in all copies.
6
+
7
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
8
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
9
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
14
+
+80
vendor/opam/iomux/README.md
+80
vendor/opam/iomux/README.md
···
1
+
# Io Multiplexers for Ocaml
2
+
3
+
[API ONLINE](https://haesbaert.github.io/ocaml-iomux)
4
+
5
+
This aims to provide very direct, as in low level bindings to poll(2),
6
+
ppoll(2), kevent(2) and epoll(2). At this time just poll(2) and
7
+
ppoll(2) are implemented.
8
+
9
+
## Poll & Ppoll
10
+
11
+
Poll and ppoll are the second generation of IO multiplexers, they're
12
+
mostly the same, but ppoll takes nanoseconds as a timeout and allows
13
+
for a list of signals to be masked atomically. Most people will be
14
+
happier with poll.
15
+
16
+
This binding operates by maintaining an opaque buffer of fd slots. You
17
+
access the internal buffer via `Poll.set_index`, `Poll.get_fd`,
18
+
`Poll.get_revents` etc. These will just fill the pollfd structure at
19
+
the given index. It's way easier to grasp this if you read the poll(2)
20
+
manpage first.
21
+
22
+
### Portability
23
+
24
+
The poll(2) system call first appeared AT&T System V Release 3 UNIX,
25
+
it is present "everywhere" and defined in "POSIX.1".
26
+
27
+
The ppoll(2) is a linux extension but portable enough:
28
+
* OpenBSD added it in OpenBSD 5.4
29
+
* FreeBSD added it in FreeBSD 11.0
30
+
* NetBSD added it in NetBSD 10.0
31
+
* DragonFly added it in DragonFly 4.6
32
+
* Macos **still does NOT have it as of 2023**
33
+
34
+
Consider using `Poll.ppoll_or_poll` to make things play nicely with
35
+
macos.
36
+
37
+
### Usage
38
+
39
+
A very basic usage would be something like this. We create a pipe, and
40
+
we want to poll for reading on input and writing on output.
41
+
42
+
```ocaml
43
+
let poll = Poll.create () in
44
+
let pipe_r, pipe_w = Unix.pipe () in
45
+
(* We'll use index 0 for the pipe, and 7 for pipe output, just because.
46
+
First we want to make sure we can write to the pipe without blocking *)
47
+
Poll.set_index poll 7 pipe_w Poll.Flags.pollout;
48
+
(* Wait why 8 ? we tell the kernel the number of file descriptors to scan,
49
+
unset filedescriptors are skipped, so indexes 1-6 are ignored *)
50
+
let nready = Poll.poll poll 8 Nowait in
51
+
assert (nready = 1); (* only one entry should be ready, since we added only one *)
52
+
let n = Unix.write pipe_w (Bytes.create 1) 0 1 in
53
+
assert (n = 1);
54
+
(* We'll now poll for both events, note that we don't need to re-add index 7 *)
55
+
Poll.set_index poll 0 pipe_r Poll.Flags.pollin;
56
+
let nready = Poll.poll poll 8 Nowait in
57
+
assert (nready = 2); (* pipe input + pipe output *)
58
+
Poll.iter_ready poll nready (fun index fd flags ->
59
+
if Poll.Flags.mem flags Poll.Flags.pollin then
60
+
Printf.printf "fd %d (from index %d) can be read without blocking\n%!"
61
+
(Util.fd_of_unix fd) index
62
+
else if Poll.Flags.mem flags Poll.Flags.pollout then
63
+
Printf.printf "fd %d (from index %d) can be written without blocking\n%!"
64
+
(Util.fd_of_unix fd) index
65
+
else
66
+
assert false);
67
+
Unix.close pipe_r;
68
+
Unix.close pipe_w;
69
+
(* clean up *)
70
+
Poll.invalidate_index poll 0;
71
+
Poll.invalidate_index poll 7
72
+
```
73
+
Should produce:
74
+
```
75
+
fd 3 (from index 0) can be read without blocking
76
+
fd 4 (from index 7) can be written without blocking
77
+
```
78
+
79
+
This interface might look a bit weird, but it does zero allocations per `set`
80
+
or `get` and only one block allocation per actual `poll` or `ppoll`.
+21
vendor/opam/iomux/dune-project
+21
vendor/opam/iomux/dune-project
···
1
+
(lang dune 3.19)
2
+
(name iomux)
3
+
(generate_opam_files true)
4
+
(source
5
+
(github ocaml-multicore/ocaml-iomux))
6
+
(authors "Christiano Haesbaert")
7
+
(maintainers "OCaml Multicore Team")
8
+
(license ISC)
9
+
(documentation https://ocaml-multicore.github.io/ocaml-iomux)
10
+
11
+
(package
12
+
(name iomux)
13
+
(synopsis "IO Multiplexer bindings")
14
+
(description "Low level bindings for Unix IO Multiplexers (poll/ppoll/kevent/epoll)")
15
+
(depends
16
+
(ocaml (>= 4.08))
17
+
dune
18
+
dune-configurator
19
+
(alcotest :with-test))
20
+
(tags
21
+
(io multiplexing poll ppoll epoll kevent kqueue)))
+35
vendor/opam/iomux/iomux.opam
+35
vendor/opam/iomux/iomux.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "IO Multiplexer bindings"
4
+
description:
5
+
"Low level bindings for Unix IO Multiplexers (poll/ppoll/kevent/epoll)"
6
+
maintainer: ["OCaml Multicore Team"]
7
+
authors: ["Christiano Haesbaert"]
8
+
license: "ISC"
9
+
tags: ["io" "multiplexing" "poll" "ppoll" "epoll" "kevent" "kqueue"]
10
+
homepage: "https://github.com/ocaml-multicore/ocaml-iomux"
11
+
doc: "https://ocaml-multicore.github.io/ocaml-iomux"
12
+
bug-reports: "https://github.com/ocaml-multicore/ocaml-iomux/issues"
13
+
depends: [
14
+
"ocaml" {>= "4.08"}
15
+
"dune" {>= "3.19"}
16
+
"dune-configurator"
17
+
"alcotest" {with-test}
18
+
"odoc" {with-doc}
19
+
]
20
+
build: [
21
+
["dune" "subst"] {dev}
22
+
[
23
+
"dune"
24
+
"build"
25
+
"-p"
26
+
name
27
+
"-j"
28
+
jobs
29
+
"@install"
30
+
"@runtest" {with-test}
31
+
"@doc" {with-doc}
32
+
]
33
+
]
34
+
dev-repo: "git+https://github.com/ocaml-multicore/ocaml-iomux.git"
35
+
x-maintenance-intent: ["(latest)"]
+24
vendor/opam/iomux/lib/dune
+24
vendor/opam/iomux/lib/dune
···
1
+
(rule
2
+
(targets config.ml config.h)
3
+
(action
4
+
(run ./include/discover.exe)))
5
+
6
+
(library
7
+
(name iomux)
8
+
(public_name iomux)
9
+
(modules iomux config poll util)
10
+
(libraries unix)
11
+
(foreign_stubs
12
+
(language c)
13
+
(flags
14
+
:standard
15
+
"-Wall"
16
+
; "-Wstrict-prototypes"
17
+
; "-Wmissing-prototypes"
18
+
; "-Wmissing-declarations"
19
+
"-Wshadow"
20
+
"-Wpointer-arith"
21
+
"-Wcast-qual"
22
+
"-Wsign-compare"
23
+
"-Werror")
24
+
(names iomux_stubs)))
+53
vendor/opam/iomux/lib/include/discover.ml
+53
vendor/opam/iomux/lib/include/discover.ml
···
1
+
module C = Configurator.V1
2
+
3
+
let has_ppoll_code = {|
4
+
#define _GNU_SOURCE /* for linux */
5
+
#include <poll.h>
6
+
#include <stddef.h>
7
+
#include <strings.h>
8
+
9
+
int
10
+
main(void)
11
+
{
12
+
struct pollfd fds;
13
+
struct timespec ts;
14
+
15
+
bzero(&fds, sizeof(fds));
16
+
bzero(&ts, sizeof(ts));
17
+
18
+
return (ppoll(&fds, 0, &ts, NULL));
19
+
}
20
+
|}
21
+
22
+
let () =
23
+
C.main ~name:"discover" @@ fun c ->
24
+
25
+
(* check for ppoll(2) *)
26
+
let has_ppoll = C.c_test c has_ppoll_code in
27
+
C.C_define.gen_header_file c ~fname:"config.h" [ "HAS_PPOLL", Switch has_ppoll ];
28
+
let has_list = [ Printf.sprintf "let has_ppoll = %b" has_ppoll ] in
29
+
30
+
(* general poll(2) definitions *)
31
+
let defs =
32
+
C.C_define.import c ~includes:["poll.h"]
33
+
C.C_define.Type.[
34
+
"POLLIN", Int;
35
+
"POLLPRI", Int;
36
+
"POLLOUT", Int;
37
+
"POLLERR", Int;
38
+
"POLLHUP", Int;
39
+
"POLLNVAL", Int;
40
+
"sizeof(struct pollfd)", Int;
41
+
]
42
+
|> List.map (function
43
+
| name, C.C_define.Value.Int v ->
44
+
let name =
45
+
match name with
46
+
| "sizeof(struct pollfd)" -> "sizeof_pollfd"
47
+
| nm -> nm
48
+
in
49
+
Printf.sprintf "let %s = 0x%x" (String.lowercase_ascii name) v
50
+
| _ -> assert false
51
+
)
52
+
in
53
+
C.Flags.write_lines "config.ml" (defs @ has_list)
+4
vendor/opam/iomux/lib/include/dune
+4
vendor/opam/iomux/lib/include/dune
+163
vendor/opam/iomux/lib/iomux_stubs.c
+163
vendor/opam/iomux/lib/iomux_stubs.c
···
1
+
#define _GNU_SOURCE
2
+
3
+
#include <errno.h>
4
+
#include <poll.h>
5
+
#include <signal.h>
6
+
7
+
#include <caml/bigarray.h>
8
+
#include <caml/memory.h>
9
+
#include <caml/mlvalues.h>
10
+
#include <caml/unixsupport.h>
11
+
#include <caml/signals.h>
12
+
13
+
#include "config.h"
14
+
15
+
/* only defined in the runtime with CAML_INTERNALS */
16
+
CAMLextern int caml_convert_signal_number (int);
17
+
18
+
/*
19
+
* Poll
20
+
*/
21
+
22
+
value
23
+
caml_iomux_poll(value v_fds, value v_nfds, value v_timo)
24
+
{
25
+
CAMLparam3(v_fds, v_nfds, v_timo);
26
+
struct pollfd *fds;
27
+
nfds_t nfds;
28
+
int timo;
29
+
int r;
30
+
31
+
fds = Caml_ba_data_val(v_fds);
32
+
nfds = Int_val(v_nfds);
33
+
timo = Int_val(v_timo);
34
+
35
+
caml_enter_blocking_section();
36
+
r = poll(fds, nfds, timo);
37
+
caml_leave_blocking_section();
38
+
if (r == -1) /* this allocs */
39
+
uerror("poll", Nothing);
40
+
41
+
CAMLreturn(Val_int(r));
42
+
}
43
+
44
+
#ifdef HAS_PPOLL
45
+
static void
46
+
decode_sigset(value vset, sigset_t * set)
47
+
{
48
+
sigemptyset(set);
49
+
for (/*nothing*/; vset != Val_emptylist; vset = Field(vset, 1)) {
50
+
int sig = caml_convert_signal_number(Int_val(Field(vset, 0)));
51
+
sigaddset(set, sig);
52
+
}
53
+
}
54
+
#endif
55
+
56
+
#define S_IN_NS 1000000000LL
57
+
value
58
+
caml_iomux_ppoll(value v_fds, value v_nfds, value v_timo, value v_sigmask)
59
+
{
60
+
#ifdef HAS_PPOLL
61
+
CAMLparam4(v_fds, v_nfds, v_timo, v_sigmask);
62
+
struct pollfd *fds;
63
+
struct timespec *timo;
64
+
struct timespec ts;
65
+
sigset_t *psigmask, sigmask;
66
+
nfds_t nfds;
67
+
int64_t timo64;
68
+
int r;
69
+
70
+
fds = Caml_ba_data_val(v_fds);
71
+
nfds = Int_val(v_nfds);
72
+
timo64 = Int64_val(v_timo);
73
+
if (timo64 == -1LL)
74
+
timo = NULL;
75
+
else {
76
+
ts.tv_sec = (time_t)(timo64 / S_IN_NS);
77
+
ts.tv_nsec = (time_t)(timo64 % S_IN_NS);
78
+
timo = &ts;
79
+
}
80
+
81
+
if (v_sigmask == Val_emptylist)
82
+
psigmask = NULL;
83
+
else {
84
+
decode_sigset(v_sigmask, &sigmask);
85
+
psigmask = &sigmask;
86
+
}
87
+
88
+
caml_enter_blocking_section();
89
+
r = ppoll(fds, nfds, timo, psigmask);
90
+
caml_leave_blocking_section();
91
+
if (r == -1) /* this allocs */
92
+
uerror("ppoll", Nothing);
93
+
94
+
CAMLreturn(Val_int(r));
95
+
#else /* HAS_PPOLL */
96
+
errno = ENOSYS;
97
+
uerror("ppoll", Nothing);
98
+
#endif /* HAS_PPOLL */
99
+
}
100
+
#undef S_IN_NS
101
+
102
+
#define pollfd_of_index(vfds, vindex) \
103
+
((struct pollfd *)Caml_ba_data_val(vfds) + (Int_val (vindex)))
104
+
105
+
value /* noalloc */
106
+
caml_iomux_poll_set_index(value v_fds, value v_index, value v_fd, value v_events)
107
+
{
108
+
struct pollfd *pfd = pollfd_of_index(v_fds, v_index);
109
+
110
+
pfd->fd = Int_val(v_fd);
111
+
pfd->events = Int_val(v_events);
112
+
113
+
return (Val_unit);
114
+
}
115
+
116
+
value
117
+
caml_iomux_poll_init(value v_fds, value v_maxfds)
118
+
{
119
+
CAMLparam2(v_fds, v_maxfds);
120
+
struct pollfd *pfd = pollfd_of_index(v_fds, Val_int(0));
121
+
int maxfds = Int_val(v_maxfds);
122
+
int i;
123
+
124
+
for (i = 0; i < maxfds; i++, pfd++) {
125
+
pfd->fd = -1;
126
+
pfd->events = 0;
127
+
}
128
+
129
+
CAMLreturn(Val_unit);
130
+
}
131
+
132
+
133
+
value /* noalloc */
134
+
caml_iomux_poll_get_revents(value v_fds, value v_index)
135
+
{
136
+
struct pollfd *pfd = pollfd_of_index(v_fds, v_index);
137
+
138
+
return (Val_int(pfd->revents));
139
+
}
140
+
141
+
value /* noalloc */
142
+
caml_iomux_poll_get_fd(value v_fds, value v_index)
143
+
{
144
+
struct pollfd *pfd = pollfd_of_index(v_fds, v_index);
145
+
146
+
return (Val_int(pfd->fd));
147
+
}
148
+
149
+
/*
150
+
* Util
151
+
*/
152
+
153
+
value
154
+
caml_iomux_poll_max_open_files(value v_unit)
155
+
{
156
+
CAMLparam1(v_unit);
157
+
long r = sysconf(_SC_OPEN_MAX);
158
+
if (r == -1) /* this allocs */
159
+
uerror("poll_max_open_files", Nothing);
160
+
else if (r > 524288)
161
+
r = 524288;
162
+
CAMLreturn (Val_int(r));
163
+
}
+139
vendor/opam/iomux/lib/poll.ml
+139
vendor/opam/iomux/lib/poll.ml
···
1
+
(*
2
+
* Copyright (c) 2023 Christiano Haesbaert <haesbaert@haesbaert.org>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*)
16
+
17
+
open Util
18
+
19
+
type buffer = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
20
+
21
+
module Raw = struct
22
+
external poll : buffer -> int -> int -> int = "caml_iomux_poll"
23
+
external ppoll : buffer -> int -> int64 -> int list -> int = "caml_iomux_ppoll"
24
+
external set_index : buffer -> int -> int -> int -> unit = "caml_iomux_poll_set_index" [@@noalloc]
25
+
external init : buffer -> int -> unit = "caml_iomux_poll_init"
26
+
external get_revents : buffer -> int -> int = "caml_iomux_poll_get_revents" [@@noalloc]
27
+
external get_fd : buffer -> int -> int = "caml_iomux_poll_get_fd" [@@noalloc]
28
+
end
29
+
30
+
module Flags = struct
31
+
type t = int
32
+
33
+
let pollin = Config.pollin
34
+
let pollpri = Config.pollpri
35
+
let pollout = Config.pollout
36
+
let pollerr = Config.pollerr
37
+
let pollhup = Config.pollhup
38
+
let pollnval = Config.pollnval
39
+
40
+
let empty = 0
41
+
42
+
let ( + ) = ( lor )
43
+
44
+
let mem a b = (a land b) <> 0
45
+
46
+
let to_int = Fun.id
47
+
let of_int = Fun.id
48
+
end
49
+
50
+
let has_ppoll = Config.has_ppoll
51
+
52
+
let invalid_fd = unix_of_fd (-1)
53
+
54
+
type t = {
55
+
buffer : buffer;
56
+
maxfds : int;
57
+
}
58
+
59
+
type poll_timeout =
60
+
| Infinite
61
+
| Nowait
62
+
| Milliseconds of int
63
+
64
+
let poll t used timeout =
65
+
let timeout = match timeout with
66
+
| Infinite -> (-1)
67
+
| Nowait -> 0
68
+
| Milliseconds ms -> ms
69
+
in
70
+
Raw.poll t.buffer used timeout
71
+
72
+
type ppoll_timeout =
73
+
| Infinite
74
+
| Nowait
75
+
| Nanoseconds of int64
76
+
77
+
let ppoll t used timeout sigmask =
78
+
let timeout = match timeout with
79
+
| Infinite -> Int64.minus_one
80
+
| Nowait -> Int64.zero
81
+
| Nanoseconds timo -> timo
82
+
in
83
+
Raw.ppoll t.buffer used timeout sigmask
84
+
85
+
let ppoll_or_poll t used (timeout : ppoll_timeout) =
86
+
if has_ppoll then
87
+
ppoll t used timeout []
88
+
else
89
+
let timeout : poll_timeout = match timeout with
90
+
| Infinite -> Infinite
91
+
| Nowait -> Nowait
92
+
| Nanoseconds timo_ns ->
93
+
Milliseconds (Int64.(to_int @@ div (add timo_ns 999_999L) 1_000_000L))
94
+
in
95
+
poll t used timeout
96
+
97
+
let guard_index t index =
98
+
if index >= t.maxfds || index < 0 then
99
+
invalid_arg "index out of bounds"
100
+
101
+
let set_index t index fd events =
102
+
guard_index t index;
103
+
Raw.set_index t.buffer index (fd_of_unix fd) events
104
+
105
+
let invalidate_index t index =
106
+
guard_index t index;
107
+
Raw.set_index t.buffer index (-1) 0
108
+
109
+
let get_revents t index =
110
+
guard_index t index;
111
+
Raw.get_revents t.buffer index
112
+
113
+
let get_fd t index =
114
+
guard_index t index;
115
+
Raw.get_fd t.buffer index |> unix_of_fd
116
+
117
+
let create ?(maxfds=Util.max_open_files ()) () =
118
+
let len = maxfds * Config.sizeof_pollfd in
119
+
let buffer = Bigarray.(Array1.create char c_layout len) in
120
+
let t = { buffer; maxfds } in
121
+
Raw.init buffer maxfds;
122
+
t
123
+
124
+
let maxfds t = t.maxfds
125
+
126
+
let iter_ready t nready (f : int -> Unix.file_descr -> Flags.t -> unit) =
127
+
let rec loop index nready =
128
+
match nready with
129
+
| 0 -> ()
130
+
| _ ->
131
+
let fd = get_fd t index in
132
+
let revents = get_revents t index in
133
+
if fd <> invalid_fd && revents <> 0 then (
134
+
f index fd revents;
135
+
loop (succ index) (pred nready)
136
+
) else
137
+
loop (succ index) nready
138
+
in
139
+
loop 0 nready
+140
vendor/opam/iomux/lib/poll.mli
+140
vendor/opam/iomux/lib/poll.mli
···
1
+
(*
2
+
* Copyright (c) 2023 Christiano Haesbaert <haesbaert@haesbaert.org>
3
+
*
4
+
* Permission to use, copy, modify, and distribute this software for any
5
+
* purpose with or without fee is hereby granted, provided that the above
6
+
* copyright notice and this permission notice appear in all copies.
7
+
*
8
+
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9
+
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10
+
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11
+
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12
+
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13
+
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14
+
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15
+
*)
16
+
17
+
(** A direct binding of poll(2). *)
18
+
19
+
type t
20
+
(** Main type for a poller. *)
21
+
22
+
val create : ?maxfds:int -> unit -> t
23
+
(** [create ?maxfds ()] creates a new poller.
24
+
@param maxfds Maximum number of fds, defaults to {!Util.max_open_files}. *)
25
+
26
+
val maxfds : t -> int
27
+
(** [maxfds t] is the maximum number of file descriptor slots allocated for [t]. *)
28
+
29
+
(** The set of flags associated with a file descriptor event. *)
30
+
module Flags : sig
31
+
32
+
type t
33
+
(** The actual set. *)
34
+
35
+
val pollin : t
36
+
(** POLLIN from poll(2). *)
37
+
38
+
val pollpri : t
39
+
(** POLLPRI from poll(2). *)
40
+
41
+
val pollout : t
42
+
(** POLLOUT from poll(2). *)
43
+
44
+
val pollerr : t
45
+
(** POLLERR from poll(2). Only expected as output, invalid as input. *)
46
+
47
+
val pollhup : t
48
+
(** POLLHUP from poll(2). Only expected as output, invalid as input. *)
49
+
50
+
val pollnval : t
51
+
(** POLLNVAL from poll(2). Only expected as output, invalid as input. *)
52
+
53
+
val empty : t
54
+
(** aka zero. *)
55
+
56
+
val ( + ) : t -> t -> t
57
+
(** The union of flags, fancy way of doing {!lor}. *)
58
+
59
+
val mem : t -> t -> bool
60
+
(** [mem x y] checks if [y] belongs to [m]. The fancy way of doing {!land}. *)
61
+
62
+
val to_int : t -> int
63
+
(** [to_int x] exposes [x] as an integer, this is an identity function. *)
64
+
65
+
val of_int : int -> t
66
+
(** [of_int x] imports [x] as {!t}, this is an identity function. *)
67
+
68
+
end
69
+
70
+
val has_ppoll : bool
71
+
(** [has_ppoll] is true if the system supports the ppoll(2) system
72
+
call. Notably macos as of 2023 does not have it. *)
73
+
74
+
val invalid_fd : Unix.file_descr
75
+
(** [invalid_fd] is the {!Unix.file_descr} of value -1. *)
76
+
77
+
(** The timeout parameter for {!poll}. *)
78
+
type poll_timeout =
79
+
| Infinite (** No timeout, wait forever *)
80
+
| Nowait (** Don't block, return immediately *)
81
+
| Milliseconds of int (** Block for at most [int] milliseconds *)
82
+
83
+
(** The actual poll(2) call *)
84
+
val poll : t -> int -> poll_timeout -> int
85
+
(** [poll t nfds timeout] polls for the first [nfds], like the system
86
+
call, invalid (-1) entries are ignored. The internal buffer is not
87
+
modified after the call. It returns the number of ready file
88
+
descriptors suitable to be used with {!iter_ready}. *)
89
+
90
+
(** The timeout parameter for {!ppoll}. Supports nanoseconds instead of milliseconds. *)
91
+
type ppoll_timeout =
92
+
| Infinite (** No timeout, wait forever *)
93
+
| Nowait (** Don't block, return immediately *)
94
+
| Nanoseconds of int64 (** Block for at most [int64] nanoseconds *)
95
+
96
+
(** The actual ppoll(2) call *)
97
+
val ppoll : t -> int -> ppoll_timeout -> int list -> int
98
+
(** [ppoll t nfds timeout sigmask] is like {!poll} but supports
99
+
nanoseconds and a list of signals that are atomically masked
100
+
during execution and restored uppon return. If the system does not
101
+
{!has_ppoll} this call will raise {!Unix.Unix_error} with
102
+
ENOSYS. You most likely want to use {!ppoll_or_poll}, see
103
+
below. *)
104
+
105
+
(** A more portable ppoll(2) call *)
106
+
val ppoll_or_poll : t -> int -> ppoll_timeout -> int
107
+
(** [ppoll_or_poll t nfds tiemout] is like {!ppoll} if the system
108
+
{!has_ppoll}, otherwise the call is emulated via {!poll}, notably
109
+
the timeout is internally converted to milliseconds and there is
110
+
no support for signal masking. You most likely want to use this
111
+
instead of {!ppoll}, the two calls are kept to prevent the user
112
+
from expecting nanoseconds resolution from an emulated {!ppoll}
113
+
call. *)
114
+
115
+
val set_index : t -> int -> Unix.file_descr -> Flags.t -> unit
116
+
(** [set_index t index fd flag] modifies the internal buffer at
117
+
[index] to listen to [flag] events of [fd]. This overwrites any
118
+
previous value of [flag] and [fd] internally. {!invalid_fd} (-1)
119
+
can be used to deactivate the slot, but usage of
120
+
{!invalidate_index} is preferred. *)
121
+
122
+
val invalidate_index : t -> int -> unit
123
+
(** [invalidate_index t index] modifies the internal buffer by
124
+
invalidating [index]. The kernel will ignore that slot. We also
125
+
clear flags, just for kicks. *)
126
+
127
+
val get_revents : t -> int -> Flags.t
128
+
(** [get_revents t index] is the returned event flags set after a call
129
+
to {!poll} or {!ppoll}. *)
130
+
131
+
val get_fd : t -> int -> Unix.file_descr
132
+
(** [get_fd t index] is the file descriptor associated with [index]. *)
133
+
134
+
val iter_ready : t -> int -> (int -> Unix.file_descr -> Flags.t -> unit) -> unit
135
+
(** [iter_ready t nready fn] scans the internal buffer for every ready
136
+
file descriptor and calls [fn index fd flags], the scanning is
137
+
aborted after [nready] entries are found. Invalid file descriptors
138
+
(set to -1 via invalidate_index) are skipped. Typical usage is that
139
+
[nready] is the return of {!poll} or {!ppoll}. The internal buffer
140
+
is left unmodified. *)
+9
vendor/opam/iomux/lib/util.ml
+9
vendor/opam/iomux/lib/util.ml
+121
vendor/opam/iomux/test/test.ml
+121
vendor/opam/iomux/test/test.ml
···
1
+
open Iomux
2
+
3
+
exception Fdleak
4
+
5
+
let _check_raises = Alcotest.check_raises
6
+
let _check_string = Alcotest.(check string)
7
+
let check_int = Alcotest.(check int)
8
+
let check_bool = Alcotest.(check bool)
9
+
10
+
module U = struct
11
+
let with_leak_checker (f : unit -> unit) () =
12
+
let fetch () =
13
+
let l = List.init (Util.max_open_files () / 2) (fun _ -> Unix.(socket PF_UNIX SOCK_STREAM 0)) in
14
+
List.iter Unix.close l;
15
+
l
16
+
in
17
+
let l1 = fetch () in
18
+
match f () with
19
+
| exception exn -> raise exn
20
+
| () ->
21
+
(* Linux is buggy. In multithreaded programs not always the
22
+
file-descriptor is released immediatelly if it has/have been
23
+
used in another thread. This causes the list to be
24
+
re-ordered, with sometimes one file descriptor showing up
25
+
only later (but it shows up so it's not a leak). So we just
26
+
fetch again. *)
27
+
if (l1 <> fetch ()) && (l1 <> fetch ()) then
28
+
raise Fdleak
29
+
30
+
let _coinflip () = Random.bool ()
31
+
32
+
let one_second_in_ns = 1000_000_000L
33
+
let hundred_ms_in_ns = 100_000_000L
34
+
35
+
end
36
+
37
+
module T = struct
38
+
39
+
let init () =
40
+
let maxfds = 1024 in
41
+
let poll = Poll.create ~maxfds () in
42
+
for i = 0 to maxfds - 1 do
43
+
let v = (Poll.get_fd poll i) = Poll.invalid_fd in
44
+
check_bool "initialized" v true
45
+
done
46
+
47
+
let basic () =
48
+
let poll = Poll.create ~maxfds:16 () in
49
+
let r, w = Unix.pipe () in
50
+
Poll.set_index poll 0 r Poll.Flags.pollin;
51
+
let b = Bytes.create 1 in
52
+
check_int "write" (Unix.write w b 0 1) 1;
53
+
let nready = Poll.poll poll 1 Nowait in
54
+
check_int "nready" nready 1;
55
+
let fd = Poll.get_fd poll 0 in
56
+
let revents = Poll.get_revents poll 0 in
57
+
check_bool "fd" true (r = fd);
58
+
check_bool "revents" true (Poll.Flags.mem revents Poll.Flags.pollin);
59
+
check_bool "revents-eq" true (revents = Poll.Flags.pollin);
60
+
Unix.close w;
61
+
Unix.close r
62
+
63
+
let ppoll_timo () =
64
+
let pollfds = Poll.create () in
65
+
try
66
+
ignore @@ Poll.ppoll pollfds 0 (Nanoseconds U.one_second_in_ns) [];
67
+
check_bool "has_ppoll true" Poll.has_ppoll true
68
+
with
69
+
Unix.Unix_error (Unix.ENOSYS,_,_) ->
70
+
check_bool "has_ppoll false" Poll.has_ppoll false
71
+
72
+
let ppoll_or_poll () =
73
+
let poll = Poll.create () in
74
+
let n = Poll.ppoll_or_poll poll 0 Nowait in
75
+
check_int "n is zero" n 0;
76
+
let n = Poll.ppoll_or_poll poll 0 (Nanoseconds U.hundred_ms_in_ns) in
77
+
check_int "n is zero" n 0
78
+
79
+
let example () =
80
+
let poll = Poll.create () in
81
+
let pipe_r, pipe_w = Unix.pipe () in
82
+
(* We'll use index 0 for the pipe, and 7 for pipe output, just because.
83
+
First we want to make sure we can write to the pipe without blocking *)
84
+
Poll.set_index poll 7 pipe_w Poll.Flags.pollout;
85
+
(* Wait why 8 ? we tell the kernel the number of file descriptors to scan,
86
+
unset filedescriptors are skipped, so indexes 1-6 are ignored *)
87
+
let nready = Poll.poll poll 8 Nowait in
88
+
check_int "nread 1" 1 nready; (* only one entry should be ready, since we added only one *)
89
+
let n = Unix.write pipe_w (Bytes.create 1) 0 1 in
90
+
check_int "n" 1 n;
91
+
(* We'll now poll for both events, note that we don't need to re-add index 7 *)
92
+
Poll.set_index poll 0 pipe_r Poll.Flags.pollin;
93
+
let nready = Poll.poll poll 8 Nowait in
94
+
check_int "nready" 2 nready;
95
+
Poll.iter_ready poll nready (fun index fd flags ->
96
+
if Poll.Flags.mem flags Poll.Flags.pollin then
97
+
Printf.printf "fd %d (from index %d) can be read without blocking\n%!"
98
+
(Util.fd_of_unix fd) index
99
+
else if Poll.Flags.mem flags Poll.Flags.pollout then
100
+
Printf.printf "fd %d (from index %d) can be written without blocking\n%!"
101
+
(Util.fd_of_unix fd) index
102
+
else
103
+
assert false);
104
+
Unix.close pipe_r;
105
+
Unix.close pipe_w;
106
+
(* clean up *)
107
+
Poll.invalidate_index poll 0;
108
+
Poll.invalidate_index poll 7
109
+
110
+
let () =
111
+
let open Alcotest in
112
+
let wlc = U.with_leak_checker in
113
+
run "Iomux" [
114
+
"init", [ test_case "" `Quick (wlc init) ];
115
+
"unit", [ test_case "" `Quick (wlc basic) ];
116
+
"ppoll_timo", [ test_case "" `Quick (wlc ppoll_timo) ];
117
+
"ppoll_or_poll", [ test_case "" `Quick (wlc ppoll_or_poll) ];
118
+
"example", [ test_case "" `Quick (wlc example) ];
119
+
]
120
+
121
+
end