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
module Address_family =
struct
type t = [
| `UNSPEC
| `INET
| `INET6
| `OTHER of int
]
let to_c = let open C.Types.Address_family in function
| `UNSPEC -> unspec
| `INET -> inet
| `INET6 -> inet6
| `OTHER i -> i
let from_c = let open C.Types.Address_family in function
| family when family = unspec -> `UNSPEC
| family when family = inet -> `INET
| family when family = inet6 -> `INET6
| family -> `OTHER family
end
module Socket_type =
struct
type t = [
| `STREAM
| `DGRAM
| `RAW
| `OTHER of int
]
let to_c = let open C.Types.Socket_type in function
| `STREAM -> stream
| `DGRAM -> dgram
| `RAW -> raw
| `OTHER i -> i
let from_c = let open C.Types.Socket_type in function
| socket_type when socket_type = stream -> `STREAM
| socket_type when socket_type = dgram -> `DGRAM
| socket_type when socket_type = raw -> `RAW
| socket_type -> `OTHER socket_type
end
type t = C.Types.Sockaddr.storage
let make () =
Ctypes.make C.Types.Sockaddr.storage
let as_sockaddr address =
Ctypes.(coerce
(ptr C.Types.Sockaddr.storage) (ptr C.Types.Sockaddr.t) (addr address))
let null =
Ctypes.(from_voidp C.Types.Sockaddr.t null)
let as_in address =
Ctypes.(coerce
(ptr C.Types.Sockaddr.storage) (ptr C.Types.Sockaddr.in_) (addr address))
let as_in6 address =
Ctypes.(coerce
(ptr C.Types.Sockaddr.storage) (ptr C.Types.Sockaddr.in6) (addr address))
let from_string c_function coerce ip port =
let storage = make () in
c_function (Ctypes.ocaml_string_start ip) port (coerce storage)
|> Error.to_result storage
let ipv4 = from_string C.Functions.Sockaddr.ip4_addr as_in
let ipv6 = from_string C.Functions.Sockaddr.ip6_addr as_in6
let finish_to_string c_function coerce storage =
let buffer_size = 64 in
let buffer = Bytes.create buffer_size in
c_function
(coerce storage)
(Ctypes.ocaml_bytes_start buffer)
(Unsigned.Size_t.of_int buffer_size)
|> ignore;
let length = Bytes.index buffer '\000' in
Some (Bytes.sub_string buffer 0 length)
let to_string storage =
let family =
Ctypes.getf storage C.Types.Sockaddr.family
|> C.Functions.Sockaddr.sa_family_to_int
|> Address_family.from_c
in
if family = `INET then
finish_to_string C.Functions.Sockaddr.ip4_name as_in storage
else if family = `INET6 then
finish_to_string C.Functions.Sockaddr.ip6_name as_in6 storage
else
None
let finish_to_port network_order_port =
Some (Unsigned.UShort.to_int (C.Functions.Sockaddr.ntohs network_order_port))
let port storage =
let family =
Ctypes.getf storage C.Types.Sockaddr.family
|> C.Functions.Sockaddr.sa_family_to_int
|> Address_family.from_c
in
if family = `INET then
finish_to_port
(Ctypes.(getf (!@ (as_in storage)) C.Types.Sockaddr.sin_port))
else if family = `INET6 then
finish_to_port
(Ctypes.(getf (!@ (as_in6 storage)) C.Types.Sockaddr.sin6_port))
else
None
let copy_storage address =
let storage = make () in
Ctypes.(addr storage <-@ !@ address);
storage
let copy_sockaddr length address =
let storage = make () in
C.Functions.Sockaddr.memcpy_from_sockaddr
(Ctypes.addr storage) address length;
storage
let wrap_c_getter c_function handle =
let storage = make () in
let length =
Ctypes.(allocate int) (Ctypes.sizeof C.Types.Sockaddr.storage) in
c_function handle (as_sockaddr storage) length
|> Error.to_result storage