@@ -159,6 +159,29 @@ module Sockaddr = struct
159
159
Format. fprintf f " udp:%a:%d" Ipaddr. pp_for_uri addr port
160
160
end
161
161
162
+ module Sockopt = struct
163
+ type _ t = ..
164
+
165
+ type _ t + =
166
+ | SO_DEBUG : bool t
167
+ | SO_BROADCAST : bool t
168
+ | SO_REUSEADDR : bool t
169
+ | SO_KEEPALIVE : bool t
170
+ | SO_DONTROUTE : bool t
171
+ | SO_OOBINLINE : bool t
172
+ | TCP_NODELAY : bool t
173
+ | IPV6_ONLY : bool t
174
+ | SO_REUSEPORT : bool t
175
+ | SO_SNDBUF : int t
176
+ | SO_RCVBUF : int t
177
+ | SO_TYPE : int t
178
+ | SO_RCVLOWAT : int t
179
+ | SO_SNDLOWAT : int t
180
+ | SO_LINGER : int option t
181
+ | SO_RCVTIMEO : float t
182
+ | SO_SNDTIMEO : float t
183
+ end
184
+
162
185
type socket_ty = [`Socket | `Close ]
163
186
type 'a socket = ([> socket_ty ] as 'a ) r
164
187
@@ -181,22 +204,34 @@ type 'a t = 'a r
181
204
constraint 'a = [> [> `Generic ] ty ]
182
205
183
206
module Pi = struct
207
+ module type SOCKET = sig
208
+ type t
209
+ val setsockopt : t -> 'a Sockopt .t -> 'a -> unit
210
+ val getsockopt : t -> 'a Sockopt .t -> 'a
211
+ end
212
+
213
+ type (_, _, _) Resource.pi + =
214
+ | Socket : ('t , (module SOCKET with type t = 't ), [> `Socket ]) Resource .pi
215
+
184
216
module type STREAM_SOCKET = sig
185
217
type tag
186
218
include Flow.Pi .SHUTDOWN
187
219
include Flow.Pi .SOURCE with type t : = t
188
220
include Flow.Pi .SINK with type t : = t
221
+ include SOCKET with type t : = t
189
222
val close : t -> unit
190
223
end
191
224
192
225
let stream_socket (type t tag ) (module X : STREAM_SOCKET with type t = t and type tag = tag ) =
193
226
Resource. handler @@
194
227
H (Resource. Close , X. close) ::
228
+ H (Socket , (module X )) ::
195
229
Resource. bindings (Flow.Pi. two_way (module X ))
196
230
197
231
module type DATAGRAM_SOCKET = sig
198
232
type tag
199
233
include Flow.Pi .SHUTDOWN
234
+ include SOCKET with type t : = t
200
235
val send : t -> ?dst : Sockaddr .datagram -> Cstruct .t list -> unit
201
236
val recv : t -> Cstruct .t -> Sockaddr .datagram * int
202
237
val close : t -> unit
@@ -208,14 +243,15 @@ module Pi = struct
208
243
let datagram_socket (type t tag ) (module X : DATAGRAM_SOCKET with type t = t and type tag = tag ) =
209
244
Resource. handler @@
210
245
Resource. bindings (Flow.Pi. shutdown (module X )) @ [
246
+ H (Socket , (module X ));
211
247
H (Datagram_socket , (module X ));
212
248
H (Resource. Close , X. close)
213
249
]
214
250
215
251
module type LISTENING_SOCKET = sig
216
252
type t
217
253
type tag
218
-
254
+ include SOCKET with type t : = t
219
255
val accept : t -> sw :Switch .t -> tag stream_socket_ty r * Sockaddr .stream
220
256
val close : t -> unit
221
257
val listening_addr : t -> Sockaddr .stream
@@ -227,6 +263,7 @@ module Pi = struct
227
263
let listening_socket (type t tag ) (module X : LISTENING_SOCKET with type t = t and type tag = tag ) =
228
264
Resource. handler [
229
265
H (Resource. Close , X. close);
266
+ H (Socket , (module X ));
230
267
H (Listening_socket , (module X ))
231
268
]
232
269
@@ -278,6 +315,14 @@ let accept_fork ~sw (t : [> 'a listening_socket_ty] r) ~on_error handle =
278
315
)
279
316
)
280
317
318
+ let setsockopt (Resource. T (t , ops )) opt v =
319
+ let module X = (val (Resource. get ops Pi. Socket )) in
320
+ X. setsockopt t opt v
321
+
322
+ let getsockopt (Resource. T (t , ops )) opt =
323
+ let module X = (val (Resource. get ops Pi. Socket )) in
324
+ X. getsockopt t opt
325
+
281
326
let listening_addr (type tag ) (Resource. T (t , ops ) : [> tag listening_socket_ty ] r ) =
282
327
let module X = (val (Resource. get ops Pi. Listening_socket )) in
283
328
X. listening_addr t
0 commit comments