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
type t = [ `Pipe ] Stream.t
module Mode =
struct
type t = [
| `READABLE
| `WRITABLE
]
let to_c = let open C.Types.Pipe.Mode in function
| `READABLE -> readable
| `WRITABLE -> writable
end
let init ?loop ?(for_handle_passing = false) () =
let pipe = Stream.allocate C.Types.Pipe.t in
C.Functions.Pipe.init (Loop.or_default loop) pipe for_handle_passing
|> Error.to_result pipe
let open_ pipe file =
C.Functions.Pipe.open_ pipe (File.to_int file)
|> Error.to_result ()
let bind pipe name =
C.Blocking.Pipe.bind pipe name
|> Error.to_result ()
let connect pipe name_or_path callback =
let request = Stream.Connect_request.make () in
let callback result =
Error.catch_exceptions callback (Error.to_result () result)
in
Request.set_callback request callback;
C.Functions.Pipe.connect
request
pipe
(Ctypes.ocaml_string_start name_or_path)
Stream.Connect_request.trampoline
let rec generic_getname ?(buffer_size = 128) c_function pipe =
let length_cell =
Ctypes.(allocate size_t) (Unsigned.Size_t.of_int buffer_size) in
let buffer = Bytes.create buffer_size in
let result = c_function pipe (Ctypes.ocaml_bytes_start buffer) length_cell in
let final_length = Unsigned.Size_t.to_int (Ctypes.(!@) length_cell) in
if result >= 0 then
Result.Ok (Bytes.sub_string buffer 0 final_length)
else
if result = C.Types.Error.enobufs then
generic_getname ~buffer_size:final_length c_function pipe
else
Error.result_from_c result
let getsockname =
generic_getname C.Functions.Pipe.getsockname
let getpeername =
generic_getname C.Functions.Pipe.getpeername
let pending_instances =
C.Functions.Pipe.pending_instances
let accept_handle pipe handle =
C.Functions.Stream.accept (Stream.coerce pipe) (Stream.coerce handle)
|> Error.to_result ()
let receive_handle pipe =
let pending_count = C.Functions.Pipe.pending_count pipe in
if pending_count = 0 then
`None
else
let pending_type = C.Functions.Pipe.pending_type pipe in
if pending_type = C.Types.Handle.Type.tcp then
`TCP (accept_handle pipe)
else if pending_type = C.Types.Handle.Type.named_pipe then
`Pipe (accept_handle pipe)
else
`None
let chmod pipe mode =
let mode = Helpers.Bit_field.list_to_c Mode.to_c mode in
C.Functions.Pipe.chmod pipe mode
|> Error.to_result ()