patrick.sirref.org
Shells in OCaml
1type t = { pool : (Unix.file_descr * bool) array }
2
3external is_actually_free : Unix.file_descr -> bool = "caml_merry_is_fd_free"
4
5let make ?(min = 200) size =
6 let pool =
7 Array.init size (fun i -> ((Obj.magic (i + min) : Unix.file_descr), true))
8 in
9 { pool }
10
11let next_free t = Array.find_index (fun (_, free) -> free) t.pool
12
13let get_fd ~sw t =
14 match next_free t with
15 | None -> Fmt.failwith "No free FDs"
16 | Some idx ->
17 let fd, _ = Array.get t.pool idx in
18 Eio.Switch.on_release sw (fun () -> Array.set t.pool idx (fd, true));
19 Array.set t.pool idx (fd, false);
20 fd
21
22let with_fd t fn =
23 Eio.Switch.run @@ fun sw ->
24 let fd = get_fd ~sw t in
25 assert (is_actually_free fd);
26 fn fd
27
28let pipe t sw =
29 let r, w = Eio_unix.pipe sw in
30 let r_fd, w_fd = (Eio_unix.Resource.fd r, Eio_unix.Resource.fd w) in
31 let new_r_fd, new_w_fd =
32 Eio_unix.Fd.use_exn "pipe" r_fd @@ fun r_fd ->
33 Eio_unix.Fd.use_exn "pipe" w_fd @@ fun w_fd ->
34 let new_r_fd = get_fd ~sw t in
35 let new_w_fd = get_fd ~sw t in
36 Unix.dup2 ~cloexec:true r_fd new_r_fd;
37 Unix.dup2 ~cloexec:true w_fd new_w_fd;
38 (new_r_fd, new_w_fd)
39 in
40 Eio_unix.Fd.close r_fd;
41 Eio_unix.Fd.close w_fd;
42 ( Eio_posix.Flow.of_fd (Eio_unix.Fd.of_unix ~close_unix:true ~sw new_r_fd),
43 Eio_posix.Flow.of_fd (Eio_unix.Fd.of_unix ~close_unix:true ~sw new_w_fd) )