Source file fd.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
open Eio.Std

type tristate = No | Yes | Unknown

(* Note: [blocking] and [seekable] are not atomic,
   but it doesn't matter if we query twice in rare cases. *)
type t = {
  fd : Rcfd.t;
  mutable blocking : tristate;
  mutable seekable : tristate;
  close_unix : bool;                          (* Whether closing this also closes the underlying FD. *)
  mutable release_hook : Eio.Switch.hook;     (* Use this on close to remove switch's [on_release] hook. *)
}

let err_closed op = Invalid_argument (op ^ ": file descriptor used after calling close!")

let use t f ~if_closed = Rcfd.use t.fd f ~if_closed

let use_exn op t f =
  Rcfd.use t.fd f ~if_closed:(fun () -> raise (err_closed op))

let close t =
  Switch.remove_hook t.release_hook;
  if t.close_unix then (
    ignore (Rcfd.close t.fd : bool)
  ) else (
    ignore (Rcfd.remove t.fd : Unix.file_descr option)
  )

let remove t =
  Switch.remove_hook t.release_hook;
  Rcfd.remove t.fd

let tristate_of_bool_opt = function
  | None -> Unknown
  | Some true -> Yes
  | Some false -> No

let of_unix_no_hook ?(close_unix=true) ?blocking ?seekable fd =
  let seekable = tristate_of_bool_opt seekable in
  let blocking = tristate_of_bool_opt blocking in
  { fd = Rcfd.make fd; blocking; seekable; close_unix; release_hook = Switch.null_hook }

let of_unix ~sw ?blocking ?seekable ~close_unix fd =
  let t = of_unix_no_hook ?blocking ?seekable ~close_unix fd in
  t.release_hook <- Switch.on_release_cancellable sw (fun () -> close t);
  t

let of_unix_list ~sw fds =
  match Switch.get_error sw with
  | Some e -> List.iter Unix.close fds; raise e
  | None -> List.map (of_unix ~sw ~close_unix:true) fds

external eio_is_blocking : Unix.file_descr -> bool = "eio_unix_is_blocking"

let is_blocking t =
  match t.blocking with
  | No -> false
  | Yes -> true
  | Unknown ->
    use t ~if_closed:(Fun.const false) @@ fun fd ->
    let blocking = eio_is_blocking fd in
    t.blocking <- if blocking then Yes else No;
    blocking

let is_seekable t =
  match t.seekable with
  | No -> false
  | Yes -> true
  | Unknown ->
    use t ~if_closed:(Fun.const false) @@ fun fd ->
    let seekable =
      match Unix.lseek fd 0 Unix.SEEK_CUR with
      | (_ : int) -> true
      | exception Unix.Unix_error (Unix.ESPIPE, "lseek", "") -> false
    in
    t.seekable <- if seekable then Yes else No;
    seekable

let is_open t = Rcfd.is_open t.fd

let rec use_exn_list op xs k =
  match xs with
  | [] -> k []
  | x :: xs ->
    use_exn op x @@ fun x ->
    use_exn_list op xs @@ fun xs ->
    k (x :: xs)

let use_exn_opt op x f =
  match x with
  | None -> f None
  | Some x -> use_exn op x (fun x -> f (Some x))

let stdin = of_unix_no_hook Unix.stdin
let stdout = of_unix_no_hook Unix.stdout
let stderr= of_unix_no_hook Unix.stderr

let pp f t = Rcfd.pp f t.fd