anil.recoil.org
TCP/TLS connection pooling for Eio
remove unnecessray tls_config wrapper
+14
-92
+3
-6
README.md
+3
-6
README.md
···
45
45
```ocaml
46
46
let run env =
47
47
Switch.run (fun sw ->
48
-
(* Create TLS configuration *)
49
-
let tls = Conpool.Tls_config.make
50
-
~authenticator:(Ca_certs.authenticator ())
51
-
()
52
-
in
48
+
(* Create TLS configuration - SNI servername is automatically set to the endpoint's hostname *)
49
+
let tls_config = Tls.Config.client ~authenticator:(Ca_certs.authenticator ()) () in
53
50
54
51
(* Create pool with TLS *)
55
52
let pool = Conpool.create
56
53
~sw
57
54
~net:(Eio.Stdenv.net env)
58
55
~clock:(Eio.Stdenv.clock env)
59
-
~tls
56
+
~tls:tls_config
60
57
()
61
58
in
62
59
+3
-3
lib/connection.ml
+3
-3
lib/connection.ml
···
23
23
let flow t = t.flow
24
24
let endpoint t = t.endpoint
25
25
let created_at t = t.created_at
26
-
let last_used t = Eio.Mutex.use_ro t.mutex (fun () -> t.last_used)
27
-
let use_count t = Eio.Mutex.use_ro t.mutex (fun () -> t.use_count)
26
+
let last_used t = t.last_used
27
+
let use_count t = t.use_count
28
28
29
29
let update_usage t ~now =
30
30
Eio.Mutex.use_rw ~protect:true t.mutex (fun () ->
···
32
32
t.use_count <- t.use_count + 1)
33
33
34
34
let pp ppf t =
35
-
let uses = Eio.Mutex.use_ro t.mutex (fun () -> t.use_count) in
35
+
let uses = t.use_count in
36
36
Fmt.pf ppf "Connection(endpoint=%a, created_at=%.2f, uses=%d)" Endpoint.pp
37
37
t.endpoint t.created_at uses
+4
-10
lib/conpool.ml
+4
-10
lib/conpool.ml
···
11
11
12
12
(* Re-export submodules *)
13
13
module Endpoint = Endpoint
14
-
module Tls_config = Tls_config
15
14
module Config = Config
16
15
module Stats = Stats
17
16
module Cmd = Cmd
···
80
79
net : 'net;
81
80
clock : 'clock;
82
81
config : Config.t;
83
-
tls : Tls_config.t option;
82
+
tls : Tls.Config.client option;
84
83
endpoints : (Endpoint.t, endpoint_pool) Hashtbl.t;
85
84
endpoints_mutex : Eio.Mutex.t;
86
85
}
···
170
169
match pool.tls with
171
170
| None ->
172
171
(socket :> connection)
173
-
| Some tls_cfg ->
172
+
| Some tls_config ->
174
173
Log.debug (fun m ->
175
174
m "Initiating TLS handshake with %a" Endpoint.pp endpoint);
176
175
let host =
177
-
match Tls_config.servername tls_cfg with
178
-
| Some name -> Domain_name.(host_exn (of_string_exn name))
179
-
| None ->
180
-
Domain_name.(host_exn (of_string_exn (Endpoint.host endpoint)))
176
+
Domain_name.(host_exn (of_string_exn (Endpoint.host endpoint)))
181
177
in
182
-
let tls_flow =
183
-
Tls_eio.client_of_flow ~host (Tls_config.config tls_cfg) socket
184
-
in
178
+
let tls_flow = Tls_eio.client_of_flow ~host tls_config socket in
185
179
Log.info (fun m ->
186
180
m "TLS connection established to %a" Endpoint.pp endpoint);
187
181
(tls_flow :> connection)
+4
-6
lib/conpool.mli
+4
-6
lib/conpool.mli
···
16
16
17
17
Each submodule also exposes its own log source for fine-grained control:
18
18
- {!Endpoint.src} - endpoint operations
19
-
- {!Tls_config.src} - TLS configuration
20
19
- {!Config.src} - pool configuration *)
21
20
22
21
(** {1 Core Types} *)
23
22
24
23
module Endpoint = Endpoint
25
24
(** Network endpoint representation *)
26
-
27
-
module Tls_config = Tls_config
28
-
(** TLS configuration for connection pools *)
29
25
30
26
module Config = Config
31
27
(** Configuration for connection pools *)
···
87
83
sw:Eio.Switch.t ->
88
84
net:'net Eio.Net.t ->
89
85
clock:'clock Eio.Time.clock ->
90
-
?tls:Tls_config.t ->
86
+
?tls:Tls.Config.client ->
91
87
?config:Config.t ->
92
88
unit ->
93
89
t
···
97
93
@param sw Switch for resource management
98
94
@param net Network interface for creating connections
99
95
@param clock Clock for timeouts and time-based validation
100
-
@param tls Optional TLS configuration applied to all connections
96
+
@param tls
97
+
Optional TLS client configuration applied to all connections. SNI
98
+
servername is automatically set to the endpoint's hostname.
101
99
@param config
102
100
Optional pool configuration (uses Config.default if not provided) *)
103
101
-25
lib/tls_config.ml
-25
lib/tls_config.ml
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
(** TLS configuration for connection pools *)
7
-
8
-
let src = Logs.Src.create "conpool.tls" ~doc:"Connection pool TLS configuration"
9
-
10
-
module Log = (val Logs.src_log src : Logs.LOG)
11
-
12
-
type t = { config : Tls.Config.client; servername : string option }
13
-
14
-
let make ~config ?servername () =
15
-
Log.debug (fun m ->
16
-
m "Creating TLS config with servername: %s"
17
-
(match servername with Some s -> s | None -> "<default>"));
18
-
{ config; servername }
19
-
20
-
let config t = t.config
21
-
let servername t = t.servername
22
-
23
-
let pp ppf t =
24
-
Fmt.pf ppf "TLS(servername=%s)"
25
-
(match t.servername with Some s -> s | None -> "<default>")
-42
lib/tls_config.mli
-42
lib/tls_config.mli
···
1
-
(*---------------------------------------------------------------------------
2
-
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
-
SPDX-License-Identifier: ISC
4
-
---------------------------------------------------------------------------*)
5
-
6
-
(** TLS configuration for connection pools *)
7
-
8
-
(** {1 Logging} *)
9
-
10
-
val src : Logs.Src.t
11
-
(** Logs source for TLS configuration operations. Configure logging with:
12
-
{[
13
-
Logs.Src.set_level Conpool.Tls_config.src (Some Logs.Debug)
14
-
]} *)
15
-
16
-
(** {1 Type} *)
17
-
18
-
type t
19
-
(** TLS configuration applied to all connections in a pool *)
20
-
21
-
(** {1 Construction} *)
22
-
23
-
val make : config:Tls.Config.client -> ?servername:string -> unit -> t
24
-
(** Create TLS configuration.
25
-
26
-
@param config TLS client configuration for all connections
27
-
@param servername
28
-
Optional SNI server name override. If [None], uses the endpoint's hostname
29
-
*)
30
-
31
-
(** {1 Accessors} *)
32
-
33
-
val config : t -> Tls.Config.client
34
-
(** Get the TLS client configuration. *)
35
-
36
-
val servername : t -> string option
37
-
(** Get the SNI server name override, if any. *)
38
-
39
-
(** {1 Pretty-printing} *)
40
-
41
-
val pp : t Fmt.t
42
-
(** Pretty-printer for TLS configuration. *)