upstream: github.com/mirleft/ocaml-tls
fix(lint): add .ocamlformat and normalize test suite names
- Add missing .ocamlformat to ocaml-linkedin and ocaml-qemu
- Lowercase test suite names in prune: Cache→cache, Locate→locate,
Module alias parsing, Warning.parse
- Fix space-block suite name: storage→space_block
- Fix space/test_build suite name: initramfs→build
+190
-451
+7
-1
test/eio/dune
+7
-1
test/eio/dune
+183
-1
test/eio/test_tls_eio.ml
+183
-1
test/eio/test_tls_eio.ml
···
1
-
let suite = ("tls_eio", [])
1
+
open Eio.Std
2
+
3
+
let () = Crypto_rng_unix.use_default ()
4
+
let null_auth ?ip:_ ~host:_ _ = Ok None
5
+
6
+
let make_cert () =
7
+
let key = X509.Private_key.generate ~bits:2048 `RSA in
8
+
let subject =
9
+
let open X509.Distinguished_name in
10
+
[ Relative_distinguished_name.singleton (CN "test") ]
11
+
in
12
+
let csr =
13
+
X509.Signing_request.create ~digest:`SHA256 subject key |> Result.get_ok
14
+
in
15
+
let pubkey = (X509.Signing_request.info csr).public_key in
16
+
let extensions =
17
+
let open X509.Extension in
18
+
let auth =
19
+
(Some (X509.Public_key.id pubkey), X509.General_name.empty, None)
20
+
in
21
+
singleton Authority_key_id (false, auth)
22
+
|> add Subject_key_id (false, X509.Public_key.id pubkey)
23
+
|> add Basic_constraints (true, (true, None))
24
+
|> add Key_usage
25
+
(true, [ `Key_cert_sign; `Digital_signature; `Key_encipherment ])
26
+
|> add Ext_key_usage (true, [ `Server_auth ])
27
+
in
28
+
let valid_from = Ptime_clock.now () in
29
+
let valid_until =
30
+
Ptime.add_span valid_from (Ptime.Span.of_int_s (60 * 60)) |> Option.get
31
+
in
32
+
let cert =
33
+
X509.Signing_request.sign csr ~valid_from ~valid_until ~digest:`SHA256
34
+
~extensions key subject
35
+
|> Result.get_ok
36
+
in
37
+
(cert, key)
38
+
39
+
let test_client_config () =
40
+
match Tls.Config.client ~authenticator:null_auth () with
41
+
| Ok _ -> ()
42
+
| Error (`Msg e) -> Alcotest.failf "client config failed: %s" e
43
+
44
+
let test_client_config_alpn () =
45
+
match
46
+
Tls.Config.client ~authenticator:null_auth
47
+
~alpn_protocols:[ "h2"; "http/1.1" ] ()
48
+
with
49
+
| Ok _ -> ()
50
+
| Error (`Msg e) -> Alcotest.failf "client config with ALPN failed: %s" e
51
+
52
+
let test_client_config_version () =
53
+
match
54
+
Tls.Config.client ~authenticator:null_auth ~version:(`TLS_1_2, `TLS_1_3) ()
55
+
with
56
+
| Ok _ -> ()
57
+
| Error (`Msg e) -> Alcotest.failf "client config with version failed: %s" e
58
+
59
+
let test_ciphers_nonempty () =
60
+
Alcotest.(check bool)
61
+
"default ciphers non-empty" true
62
+
(Tls.Config.Ciphers.default <> [])
63
+
64
+
let test_ciphers_fs_subset () =
65
+
let fs = Tls.Config.Ciphers.fs in
66
+
let supported = Tls.Config.Ciphers.supported in
67
+
List.iter
68
+
(fun c ->
69
+
Alcotest.(check bool) "fs cipher in supported" true (List.mem c supported))
70
+
fs
71
+
72
+
let test_ciphers_http2_nonempty () =
73
+
Alcotest.(check bool)
74
+
"http2 ciphers non-empty" true
75
+
(Tls.Config.Ciphers.http2 <> [])
76
+
77
+
let test_supported_groups () =
78
+
Alcotest.(check bool)
79
+
"supported groups non-empty" true
80
+
(Tls.Config.supported_groups <> [])
81
+
82
+
let test_min_dh_size () =
83
+
Alcotest.(check bool) "min DH size > 0" true (Tls.Config.min_dh_size > 0)
84
+
85
+
let test_min_rsa_key_size () =
86
+
Alcotest.(check bool)
87
+
"min RSA key size > 0" true
88
+
(Tls.Config.min_rsa_key_size > 0)
89
+
90
+
let test_default_sig_algs () =
91
+
Alcotest.(check bool)
92
+
"default sig algs non-empty" true
93
+
(Tls.Config.default_signature_algorithms <> [])
94
+
95
+
(* Full TLS handshake via Eio fibers using mock sockets. Tests the complete
96
+
tls-eio path: server_of_flow, client_of_flow, write, read, shutdown. *)
97
+
let test_eio_roundtrip () =
98
+
let cert, key = make_cert () in
99
+
let server_cfg =
100
+
Tls.Config.server ~certificates:(`Single ([ cert ], key)) ()
101
+
|> Result.get_ok
102
+
in
103
+
let client_cfg =
104
+
Tls.Config.client ~authenticator:null_auth () |> Result.get_ok
105
+
in
106
+
Eio_mock.Backend.run @@ fun () ->
107
+
Switch.run @@ fun sw ->
108
+
let client_sock, server_sock = Mock_socket.create_pair () in
109
+
Mock_socket.transmit client_sock `Drain;
110
+
Mock_socket.transmit server_sock `Drain;
111
+
let msg = "hello eio tls" in
112
+
let server_received = ref "" in
113
+
let server_fiber =
114
+
Fiber.fork_promise ~sw (fun () ->
115
+
let tls = Tls_eio.server_of_flow server_cfg server_sock in
116
+
server_received := Eio.Flow.read_all tls)
117
+
in
118
+
let client_fiber =
119
+
Fiber.fork_promise ~sw (fun () ->
120
+
let tls = Tls_eio.client_of_flow client_cfg client_sock in
121
+
Eio.Flow.copy_string msg tls;
122
+
Eio.Flow.shutdown tls `Send)
123
+
in
124
+
Promise.await_exn client_fiber;
125
+
Promise.await_exn server_fiber;
126
+
Alcotest.(check string) "server received" msg !server_received
127
+
128
+
let test_eio_epoch () =
129
+
let cert, key = make_cert () in
130
+
let server_cfg =
131
+
Tls.Config.server ~certificates:(`Single ([ cert ], key)) ()
132
+
|> Result.get_ok
133
+
in
134
+
let client_cfg =
135
+
Tls.Config.client ~authenticator:null_auth () |> Result.get_ok
136
+
in
137
+
Eio_mock.Backend.run @@ fun () ->
138
+
Switch.run @@ fun sw ->
139
+
let client_sock, server_sock = Mock_socket.create_pair () in
140
+
Mock_socket.transmit client_sock `Drain;
141
+
Mock_socket.transmit server_sock `Drain;
142
+
let server_fiber =
143
+
Fiber.fork_promise ~sw (fun () ->
144
+
let tls = Tls_eio.server_of_flow server_cfg server_sock in
145
+
Eio.Flow.shutdown tls `All;
146
+
Tls_eio.epoch tls)
147
+
in
148
+
let client_fiber =
149
+
Fiber.fork_promise ~sw (fun () ->
150
+
let tls = Tls_eio.client_of_flow client_cfg client_sock in
151
+
Eio.Flow.shutdown tls `All;
152
+
Tls_eio.epoch tls)
153
+
in
154
+
let client_epoch = Promise.await_exn client_fiber in
155
+
let server_epoch = Promise.await_exn server_fiber in
156
+
(match client_epoch with
157
+
| Error () -> Alcotest.fail "expected active epoch on client"
158
+
| Ok ep ->
159
+
Alcotest.(check bool)
160
+
"cipher in defaults" true
161
+
(List.mem ep.Tls.Core.ciphersuite Tls.Config.Ciphers.default));
162
+
match server_epoch with
163
+
| Error () -> Alcotest.fail "expected active epoch on server"
164
+
| Ok _ -> ()
165
+
166
+
let suite =
167
+
( "tls_eio",
168
+
[
169
+
Alcotest.test_case "client_config" `Quick test_client_config;
170
+
Alcotest.test_case "client_config_alpn" `Quick test_client_config_alpn;
171
+
Alcotest.test_case "client_config_version" `Quick
172
+
test_client_config_version;
173
+
Alcotest.test_case "ciphers_nonempty" `Quick test_ciphers_nonempty;
174
+
Alcotest.test_case "ciphers_fs_subset" `Quick test_ciphers_fs_subset;
175
+
Alcotest.test_case "ciphers_http2_nonempty" `Quick
176
+
test_ciphers_http2_nonempty;
177
+
Alcotest.test_case "supported_groups" `Quick test_supported_groups;
178
+
Alcotest.test_case "min_dh_size" `Quick test_min_dh_size;
179
+
Alcotest.test_case "min_rsa_key_size" `Quick test_min_rsa_key_size;
180
+
Alcotest.test_case "default_sig_algs" `Quick test_default_sig_algs;
181
+
Alcotest.test_case "eio_roundtrip" `Slow test_eio_roundtrip;
182
+
Alcotest.test_case "eio_epoch" `Slow test_eio_epoch;
183
+
] )
-5
test/unix/dune
-5
test/unix/dune
-1
test/unix/test.ml
-1
test/unix/test.ml
···
1
-
let () = Alcotest.run "tls-unix" [ Test_tls_unix.suite ]
-1
test/unix/test_tls_unix.ml
-1
test/unix/test_tls_unix.ml
···
1
-
let suite = ("tls_unix", [])
-1
test/unix/test_tls_unix.mli
-1
test/unix/test_tls_unix.mli
···
1
-
val suite : string * unit Alcotest.test_case list
-5
unix/dune
-5
unix/dune
-337
unix/tls_unix.ml
-337
unix/tls_unix.ml
···
1
-
(* NOTE: mostly copied from miou/tls_miou_unix.ml, so any change should be synchronized. *)
2
-
3
-
let src = Logs.Src.create "tls-unix"
4
-
5
-
module Log = (val Logs.src_log src : Logs.LOG)
6
-
7
-
external reraise : exn -> 'a = "%reraise"
8
-
9
-
let ( $ ) f x = f x
10
-
11
-
exception Tls_alert of Tls.Packet.alert_type
12
-
exception Tls_failure of Tls.Engine.failure
13
-
exception Closed_by_peer
14
-
15
-
let () =
16
-
Printexc.register_printer @@ function
17
-
| Closed_by_peer -> Some "Connection closed by peer"
18
-
| Tls_alert alert -> Some (Tls.Packet.alert_type_to_string alert)
19
-
| Tls_failure failure -> Some (Tls.Engine.string_of_failure failure)
20
-
| _ -> None
21
-
22
-
type state =
23
-
[ `Active of Tls.Engine.state
24
-
| `Read_closed of Tls.Engine.state
25
-
| `Write_closed of Tls.Engine.state
26
-
| `Closed
27
-
| `Error of exn ]
28
-
29
-
type t = {
30
-
role : [ `Server | `Client ];
31
-
fd : Unix.file_descr;
32
-
mutable state : state;
33
-
mutable linger : string option;
34
-
read_buffer_size : int;
35
-
buf : bytes;
36
-
mutable rd_closed : bool;
37
-
}
38
-
39
-
let file_descr { fd; _ } = fd
40
-
41
-
let half_close state mode =
42
-
match (state, mode) with
43
-
| `Active tls, `read -> `Read_closed tls
44
-
| `Active tls, `write -> `Write_closed tls
45
-
| `Active _, `read_write -> `Closed
46
-
| `Read_closed tls, `read -> `Read_closed tls
47
-
| `Read_closed _, (`write | `read_write) -> `Closed
48
-
| `Write_closed tls, `write -> `Write_closed tls
49
-
| `Write_closed _, (`read | `read_write) -> `Closed
50
-
| ((`Closed | `Error _) as e), (`read | `write | `read_write) -> e
51
-
52
-
let inject_state tls = function
53
-
| `Active _ -> `Active tls
54
-
| `Read_closed _ -> `Read_closed tls
55
-
| `Write_closed _ -> `Write_closed tls
56
-
| (`Closed | `Error _) as e -> e
57
-
58
-
let tls_alert a = Tls_alert a
59
-
let tls_fail f = Tls_failure f
60
-
let inhibit fn v = try fn v with _exn -> ()
61
-
62
-
let rec unix_write fd str off len =
63
-
let written = Unix.write_substring fd str off len in
64
-
if not (Int.equal written len) then
65
-
unix_write fd str (off + written) (len - written)
66
-
67
-
let write flow str =
68
-
Log.debug (fun m -> m "try to write %d byte(s)" (String.length str));
69
-
try unix_write flow.fd str 0 (String.length str) with
70
-
| Unix.Unix_error ((Unix.EPIPE | Unix.ECONNRESET), _, _) ->
71
-
flow.state <- half_close flow.state `write;
72
-
raise Closed_by_peer
73
-
| Unix.Unix_error (_, _, _) as exn ->
74
-
flow.state <- `Error exn;
75
-
reraise exn
76
-
77
-
let handle flow tls str =
78
-
match Tls.Engine.handle_tls tls str with
79
-
| Ok (state, eof, `Response resp, `Data data) ->
80
-
Log.debug (fun m -> m "We handled %d byte(s)" (String.length str));
81
-
let state = inject_state state flow.state in
82
-
let state =
83
-
Option.(
84
-
value ~default:state (map (fun `Eof -> half_close state `read) eof))
85
-
in
86
-
flow.state <- state;
87
-
let to_close = flow.state = `Closed in
88
-
Option.iter (inhibit $ write flow) resp;
89
-
(* NOTE(dinosaure): [write flow] can set [flow.state]. So we must
90
-
check if the actual [flow.state] or the [flow.state] after [write flow]
91
-
want to close the underlying file-descriptor. *)
92
-
if to_close || flow.state = `Closed then Unix.close flow.fd;
93
-
data
94
-
| Error (fail, `Response resp) ->
95
-
let exn = match fail with `Alert a -> tls_alert a | f -> tls_fail f in
96
-
flow.state <- `Error exn;
97
-
let _ = inhibit (write flow) resp in
98
-
raise exn
99
-
100
-
let read flow =
101
-
match Unix.read flow.fd flow.buf 0 (Bytes.length flow.buf) with
102
-
| 0 -> Ok String.empty
103
-
| len -> Ok (Bytes.sub_string flow.buf 0 len)
104
-
| exception Unix.Unix_error (Unix.ECONNRESET, _, _) -> Ok String.empty
105
-
| exception exn -> Error exn
106
-
107
-
let not_errored = function `Error _ -> false | _ -> true
108
-
let garbage flow = match flow.linger with Some "" | None -> false | _ -> true
109
-
110
-
let read_react flow =
111
-
match flow.state with
112
-
| `Error exn -> raise exn
113
-
| `Read_closed _ | `Closed when garbage flow ->
114
-
(* XXX(dinosaure): [`Closed] can appear "at the same time" than some
115
-
application-data. In that case, we stored them into [t.linger]. Depending
116
-
on who closed the connection, [read_react] gives this /garbage/ in any
117
-
situation (even if the user closed the connection).
118
-
119
-
An extra layer with [read] below check if [`Read_closed]/[`Close] comes
120
-
from the network (the peer closed the connection) or the user. In the
121
-
first case, we must give pending application-data. In the second case,
122
-
we must return [0] (or raise [End_of_file]). *)
123
-
let mbuf = flow.linger in
124
-
flow.linger <- None;
125
-
mbuf
126
-
| `Read_closed _ | `Closed ->
127
-
(* XXX(dinosaure): the goal of [read_react] is to read some encrypted bytes
128
-
and try to decrypt them with [handle]. If the linger is empty, this means
129
-
that we're trying to get more data (to decrypt) when we can't get any
130
-
more. From this point of view, it's an error that needs to be notified.
131
-
However, this error can be interpreted in 2 ways:
132
-
- we want to have more data decrypted. In this case, this error is
133
-
expected and may result in the user being told that there is nothing
134
-
left to read (for example, returning 0).
135
-
- we attempt a handshake. In this case, we are dealing with an unexpected
136
-
error. *)
137
-
raise End_of_file
138
-
| `Active _ | `Write_closed _ ->
139
-
Log.debug (fun m -> m "read something from the TLS session");
140
-
match read flow with
141
-
| Error exn ->
142
-
if not_errored flow.state then flow.state <- `Error exn;
143
-
raise exn
144
-
| Ok "" ->
145
-
(* XXX(dinosaure): see [`Read_closed _ | `Closed] case. *)
146
-
raise End_of_file
147
-
| Ok str ->
148
-
Log.debug (fun m -> m "got %d byte(s)" (String.length str));
149
-
match flow.state with
150
-
| `Active tls | `Read_closed tls | `Write_closed tls -> handle flow tls str
151
-
| `Closed -> raise End_of_file
152
-
| `Error exn -> raise exn
153
-
[@@ocamlformat "disable"]
154
-
155
-
let rec read_in flow ?(off = 0) ?len buf =
156
-
let len = Option.value ~default:(Bytes.length buf - off) len in
157
-
let write_in res =
158
-
let rlen = String.length res in
159
-
let mlen = min len rlen in
160
-
Bytes.blit_string res 0 buf off mlen;
161
-
let linger =
162
-
if mlen < rlen then Some (String.sub res mlen (rlen - mlen)) else None
163
-
in
164
-
flow.linger <- linger;
165
-
mlen
166
-
in
167
-
match flow.linger with
168
-
| Some res -> write_in res
169
-
| None -> (
170
-
match read_react flow with
171
-
| None -> read_in ~off ~len flow buf
172
-
| Some res -> write_in res)
173
-
174
-
let writev flow bufs =
175
-
match flow.state with
176
-
| `Closed | `Write_closed _ -> raise Closed_by_peer
177
-
| `Error exn -> reraise exn
178
-
| `Active tls | `Read_closed tls -> (
179
-
match Tls.Engine.send_application_data tls bufs with
180
-
| Some (tls, answer) ->
181
-
flow.state <- inject_state tls flow.state;
182
-
write flow answer
183
-
| None -> assert false)
184
-
185
-
let rec drain_handshake flow =
186
-
let push_linger flow mcs =
187
-
match (mcs, flow.linger) with
188
-
| None, _ -> ()
189
-
| scs, None -> flow.linger <- scs
190
-
| Some cs, Some l -> flow.linger <- Some (l ^ cs)
191
-
in
192
-
match flow.state with
193
-
| `Active tls when not (Tls.Engine.handshake_in_progress tls) -> flow
194
-
| (`Read_closed _ | `Closed) when garbage flow -> flow
195
-
| _ ->
196
-
Log.debug (fun m -> m "start to read something from the TLS session");
197
-
let mcs = read_react flow in
198
-
push_linger flow mcs;
199
-
drain_handshake flow
200
-
201
-
let close flow =
202
-
match flow.state with
203
-
| `Active tls | `Read_closed tls ->
204
-
let tls, str = Tls.Engine.send_close_notify tls in
205
-
flow.rd_closed <- true;
206
-
flow.state <- inject_state tls flow.state;
207
-
flow.state <- `Closed;
208
-
inhibit (write flow) str;
209
-
Unix.close flow.fd
210
-
| `Write_closed _ ->
211
-
flow.rd_closed <- true;
212
-
flow.state <- `Closed;
213
-
Unix.close flow.fd
214
-
| `Closed -> flow.rd_closed <- true
215
-
| `Error _ ->
216
-
flow.rd_closed <- true;
217
-
Unix.close flow.fd
218
-
219
-
let closed_by_user flow = function
220
-
| `read | `read_write -> flow.rd_closed <- true
221
-
| `write -> ()
222
-
223
-
let shutdown flow mode =
224
-
closed_by_user flow mode;
225
-
match (flow.state, mode) with
226
-
| `Active tls, `read ->
227
-
Log.debug (fun m -> m "shutdown `read");
228
-
flow.state <- inject_state tls (half_close flow.state mode)
229
-
| (`Active tls | `Read_closed tls), (`write | `read_write) ->
230
-
let tls, str = Tls.Engine.send_close_notify tls in
231
-
flow.state <- inject_state tls (half_close flow.state mode);
232
-
(* NOTE(dinosaure): [write flow] can set [flow.state]. So we must
233
-
check if the actual [flow.state] or the [flow.state] after [write flow]
234
-
want to close the underlying file-descriptor. *)
235
-
let to_close = flow.state = `Closed in
236
-
inhibit (write flow) str;
237
-
if to_close || flow.state = `Closed then Unix.close flow.fd
238
-
| `Write_closed tls, (`read | `read_write) ->
239
-
flow.state <- inject_state tls (half_close flow.state mode);
240
-
if flow.state = `Closed then Unix.close flow.fd
241
-
| `Error _, _ -> Unix.close flow.fd
242
-
| `Read_closed _, `read -> ()
243
-
| `Write_closed _, `write -> ()
244
-
| `Closed, _ -> ()
245
-
246
-
let client_of_fd conf ?(read_buffer_size = 0x1000) ?host fd =
247
-
let conf' =
248
-
match host with None -> conf | Some host -> Tls.Config.peer conf host
249
-
in
250
-
let tls, init = Tls.Engine.client conf' in
251
-
let tls_flow =
252
-
{
253
-
role = `Client;
254
-
fd;
255
-
state = `Active tls;
256
-
linger = None;
257
-
read_buffer_size;
258
-
buf = Bytes.make read_buffer_size '\000';
259
-
rd_closed = false;
260
-
}
261
-
in
262
-
write tls_flow init;
263
-
drain_handshake tls_flow
264
-
265
-
let server_of_fd conf ?(read_buffer_size = 0x1000) fd =
266
-
let tls = Tls.Engine.server conf in
267
-
let tls_flow =
268
-
{
269
-
role = `Server;
270
-
fd;
271
-
state = `Active tls;
272
-
linger = None;
273
-
read_buffer_size;
274
-
buf = Bytes.make read_buffer_size '\000';
275
-
rd_closed = false;
276
-
}
277
-
in
278
-
drain_handshake tls_flow
279
-
280
-
let write flow ?(off = 0) ?len str =
281
-
let len = Option.value ~default:(String.length str - off) len in
282
-
if off < 0 || len < 0 || off > String.length str - len then
283
-
invalid_arg "Tls_unix.write";
284
-
if len > 0 then writev flow [ String.sub str off len ]
285
-
286
-
let read t ?(off = 0) ?len buf =
287
-
let len = Option.value ~default:(Bytes.length buf - off) len in
288
-
if off < 0 || len < 0 || off > Bytes.length buf - len then
289
-
invalid_arg "Tls_unix.read";
290
-
if t.rd_closed then 0 else try read_in t ~off ~len buf with End_of_file -> 0
291
-
292
-
let rec really_read_go t off len buf =
293
-
let len' = read t buf ~off ~len in
294
-
if len' == 0 then raise End_of_file
295
-
else if len - len' > 0 then really_read_go t (off + len') (len - len') buf
296
-
297
-
let really_read t ?(off = 0) ?len buf =
298
-
let len = Option.value ~default:(Bytes.length buf - off) len in
299
-
if off < 0 || len < 0 || off > Bytes.length buf - len then
300
-
invalid_arg "Tls_unix.really_read";
301
-
if len > 0 then really_read_go t off len buf
302
-
303
-
let resolve host service =
304
-
let tcp = Unix.getprotobyname "tcp" in
305
-
match Unix.getaddrinfo host service [ AI_PROTOCOL tcp.p_proto ] with
306
-
| [] -> Fmt.invalid_arg "No address for %s:%s" host service
307
-
| ai :: _ -> ai.ai_addr
308
-
309
-
let connect authenticator (v, port) =
310
-
let conf =
311
-
match Tls.Config.client ~authenticator () with
312
-
| Ok config -> config
313
-
| Error (`Msg msg) -> Fmt.invalid_arg "Configuration failure: %s" msg
314
-
in
315
-
let addr = resolve v (string_of_int port) in
316
-
let fd =
317
-
match addr with
318
-
| Unix.ADDR_UNIX _ -> invalid_arg "Tls_unix.connect: Invalid UNIX socket"
319
-
| Unix.ADDR_INET (inet_addr, _) ->
320
-
if Unix.is_inet6_addr inet_addr then
321
-
Unix.socket Unix.PF_INET6 Unix.SOCK_STREAM 0
322
-
else Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0
323
-
in
324
-
let host = Result.to_option Domain_name.(Result.bind (of_string v) host) in
325
-
match Unix.connect fd addr with
326
-
| () -> client_of_fd conf ?host fd
327
-
| exception exn ->
328
-
Unix.close fd;
329
-
raise exn
330
-
331
-
let epoch flow =
332
-
match flow.state with
333
-
| `Active tls | `Read_closed tls | `Write_closed tls -> (
334
-
match Tls.Engine.epoch tls with
335
-
| Error () -> assert false
336
-
| Ok data -> Some data)
337
-
| _ -> None
-99
unix/tls_unix.mli
-99
unix/tls_unix.mli
···
1
-
(** Effectful operations using Unix for pure TLS.
2
-
3
-
The pure TLS is state and buffer in, state and buffer out. This module uses
4
-
the Unix layer for communication over the network. *)
5
-
6
-
exception Tls_alert of Tls.Packet.alert_type
7
-
exception Tls_failure of Tls.Engine.failure
8
-
exception Closed_by_peer
9
-
10
-
type t
11
-
(** Abstract type of a session. *)
12
-
13
-
val file_descr : t -> Unix.file_descr
14
-
(** [file_descr] returns the underlying file-descriptor used by the given TLS
15
-
{i socket}. *)
16
-
17
-
val read : t -> ?off:int -> ?len:int -> bytes -> int
18
-
(** [read fd buf ~off ~len] reads up to [len] bytes (defaults to
19
-
[Bytes.length buf - off] from the given TLS {i socket} [fd], storing them in
20
-
byte sequence [buf], starting at position [off] in [buf] (defaults to [0]).
21
-
It returns the actual number of characters read, between 0 and [len]
22
-
(inclusive).
23
-
24
-
@raise Unix_error
25
-
raised by the system call {!val:Unix.read}. The function handles
26
-
{!val:Unix.EINTR}, {!val:Unix.EAGAIN} and {!val:Unix.EWOULDBLOCK}
27
-
exceptions and redo the system call.
28
-
29
-
@raise Invalid_argument
30
-
if [off] and [len] do not designate a valid range of [buf]. *)
31
-
32
-
val really_read : t -> ?off:int -> ?len:int -> bytes -> unit
33
-
(** [really_read fd buf ~off ~len] reads [len] bytes (defaults to
34
-
[Bytes.length buf - off]) from the given TLS {i socket} [fd], storing them
35
-
in byte sequence [buf], starting at position [off] in [buf] (defaults to
36
-
[0]). If [len = 0], [really_read] does nothing.
37
-
38
-
@raise Unix_error
39
-
raised by the system call {!val:Unix.read}. The function handles
40
-
{!val:Unix.EINTR}, {!val:Unix.EAGAIN} and {!val:Unix.EWOULDBLOCK}
41
-
exceptions and redo the system call.
42
-
43
-
@raise End_of_file
44
-
if {!val:Unix.read} returns [0] before [len] characters have been read.
45
-
46
-
@raise Invalid_argument
47
-
if [off] and [len] do not designate a valid range of [buf]. *)
48
-
49
-
val write : t -> ?off:int -> ?len:int -> string -> unit
50
-
(** [write t str ~off ~len] writes [len] bytes (defaults to
51
-
[String.length str - off]) from byte sequence [str], starting at offset
52
-
[off] (defaults to [0]), to the given TLS {i socket} [fd].
53
-
54
-
@raise Unix_error
55
-
raised by the syscall call {!val:Unix.write}. The function handles
56
-
{!val:Unix.EINTR}, {!val:Unix.EAGAIN} and {!val:Unix.EWOULDBLOCK}
57
-
exceptions and redo the system call.
58
-
59
-
@raise Closed_by_peer
60
-
if [t] is connected to a peer whose reading end is closed. Similar to the
61
-
{!val:EPIPE} error for pipe/socket connected.
62
-
63
-
@raise Invalid_argument
64
-
if [off] and [len] do not designate a valid range of [buf]. *)
65
-
66
-
val close : t -> unit
67
-
(** [close flow] closes the TLS session and the underlying file-descriptor. *)
68
-
69
-
val shutdown : t -> [ `read | `write | `read_write ] -> unit
70
-
(** [shutdown t direction] closes the direction of the TLS session [t]. If
71
-
[`read_write] or [`write] is closed, a TLS close-notify is sent to the other
72
-
endpoint. If this results in a fully-closed session (or an errorneous
73
-
session), the underlying file descriptor is closed. *)
74
-
75
-
val client_of_fd :
76
-
Tls.Config.client ->
77
-
?read_buffer_size:int ->
78
-
?host:[ `host ] Domain_name.t ->
79
-
Unix.file_descr ->
80
-
t
81
-
(** [client_of_fd client ~host fd] is [t], after client-side TLS handshake of
82
-
[fd] using [client] configuration and [host].
83
-
84
-
@raise End_of_file if we are not able to complete the handshake. *)
85
-
86
-
val server_of_fd :
87
-
Tls.Config.server -> ?read_buffer_size:int -> Unix.file_descr -> t
88
-
(** [server_of_fd server fd] is [t], after server-side TLS handshake of [fd]
89
-
using [server] configuration.
90
-
91
-
@raise End_of_file if we are not able to complete the handshake. *)
92
-
93
-
val connect : X509.Authenticator.t -> string * int -> t
94
-
(** [connect authenticator addr] is [t], a connected TLS connection to [addr]
95
-
using the default configuration and the [authenticator]. *)
96
-
97
-
val epoch : t -> Tls.Core.epoch_data option
98
-
(** [epoch t] returns [epoch], which contains information of the active session.
99
-
*)