Source file ipv6_multicast_lwt.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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
open Ipv6_multicast
module Socket = struct
type 'a domain = 'a Ipv6_multicast.Socket.domain
type 'a typ = 'a Ipv6_multicast.Socket.typ
type ('domain, 'typ) t = {
sock : ('domain, 'typ) Ipv6_multicast.Socket.t ;
fd : Unix.file_descr ;
lwt : Lwt_unix.file_descr ;
}
let create ?proto domain typ =
let sock = Socket.create ?proto domain typ in
let fd = Socket.to_fd sock in
let lwt = Lwt_unix.of_unix_file_descr ~blocking:false fd in
{ sock ; fd ; lwt }
end
module Sockopt = struct
let set { Socket.sock } opt = Sockopt.set sock opt
end
let bind { Socket.sock ; lwt } sa =
Lwt_unix.check_descriptor lwt ;
bind sock sa
let connect { Socket.sock ; fd ; lwt } sa =
let open Lwt_unix in
if Sys.win32 then
let in_progress = ref false in
wrap_syscall Write lwt begin fun () ->
if !in_progress then
if writable lwt then
try
Ipv6_multicast.connect sock sa
with
| Unix.Unix_error (EISCONN, _, _) ->
Ok ()
else
raise Retry
else
try
Ipv6_multicast.connect sock sa
with
| Unix.Unix_error (EWOULDBLOCK, _, _) ->
in_progress := true;
raise Retry
end
else
let in_progress = ref false in
wrap_syscall Write lwt begin fun () ->
if !in_progress then
match Unix.getsockopt_error fd with
| None ->
Ok ()
| Some err ->
raise (Unix.Unix_error(err, "connect", ""))
else
try
Ipv6_multicast.connect sock sa
with
| Unix.Unix_error (EINPROGRESS, _, _) ->
in_progress := true;
raise Retry
end
let send ?saddr ?flags { Socket.sock ; lwt } cs =
Lwt_unix.(wrap_syscall Write lwt begin fun () ->
Ipv6_multicast.send ?saddr ?flags sock cs
end)
let send_bytes ?saddr ?flags { Socket.sock ; lwt } buf pos len =
if pos < 0 || len < 0 || pos > Bytes.length buf - len then
Lwt.fail_invalid_arg "send_bytes"
else
Lwt_unix.(wrap_syscall Write lwt begin fun () ->
Ipv6_multicast.send_bytes ?saddr ?flags sock buf pos len
end)
let recv ?flags { Socket.sock ; lwt } cs =
Lwt_unix.(wrap_syscall Read lwt begin fun () ->
Ipv6_multicast.recv ?flags sock cs
end)
let recv_bytes ?flags { Socket.sock ; lwt } buf pos len =
if pos < 0 || len < 0 || pos > Bytes.length buf - len then
Lwt.fail_invalid_arg "recv_bytes"
else
Lwt_unix.(wrap_syscall Read lwt begin fun () ->
Ipv6_multicast.recv_bytes ?flags sock buf pos len
end)
let recvfrom ?flags { Socket.sock ; lwt } cs =
Lwt_unix.(wrap_syscall Read lwt begin fun () ->
Ipv6_multicast.recvfrom ?flags sock cs
end)
let recvfrom_bytes ?flags { Socket.sock ; lwt } buf pos len =
if pos < 0 || len < 0 || pos > Bytes.length buf - len then
Lwt.fail_invalid_arg "recvfrom_bytes"
else
Lwt_unix.(wrap_syscall Read lwt begin fun () ->
Ipv6_multicast.recvfrom_bytes ?flags sock buf pos len
end)