anil.recoil.org
TCP/TLS connection pooling for Eio
init
+1
.gitignore
+1
.gitignore
···
···
1
+
_build
+33
conpool.opam
+33
conpool.opam
···
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Protocol-agnostic TCP/IP connection pooling library for Eio"
4
+
description:
5
+
"Conpool is a connection pooling library built on Eio.Pool that manages TCP connection lifecycles, validates connection health, and provides per-endpoint resource limiting for any TCP-based protocol (HTTP, Redis, PostgreSQL, etc.)"
6
+
maintainer: ["Your Name"]
7
+
authors: ["Your Name"]
8
+
license: "MIT"
9
+
homepage: "https://github.com/username/conpool"
10
+
bug-reports: "https://github.com/username/conpool/issues"
11
+
depends: [
12
+
"ocaml"
13
+
"dune" {>= "3.0" & >= "3.0"}
14
+
"eio"
15
+
"tls-eio" {>= "1.0"}
16
+
"logs"
17
+
"odoc" {with-doc}
18
+
]
19
+
build: [
20
+
["dune" "subst"] {dev}
21
+
[
22
+
"dune"
23
+
"build"
24
+
"-p"
25
+
name
26
+
"-j"
27
+
jobs
28
+
"@install"
29
+
"@runtest" {with-test}
30
+
"@doc" {with-doc}
31
+
]
32
+
]
33
+
dev-repo: "git+https://github.com/username/conpool.git"
+24
dune-project
+24
dune-project
···
···
1
+
(lang dune 3.0)
2
+
(name conpool)
3
+
4
+
(generate_opam_files true)
5
+
6
+
(source
7
+
(github username/conpool))
8
+
9
+
(authors "Your Name")
10
+
11
+
(maintainers "Your Name")
12
+
13
+
(license MIT)
14
+
15
+
(package
16
+
(name conpool)
17
+
(synopsis "Protocol-agnostic TCP/IP connection pooling library for Eio")
18
+
(description "Conpool is a connection pooling library built on Eio.Pool that manages TCP connection lifecycles, validates connection health, and provides per-endpoint resource limiting for any TCP-based protocol (HTTP, Redis, PostgreSQL, etc.)")
19
+
(depends
20
+
ocaml
21
+
(dune (>= 3.0))
22
+
eio
23
+
(tls-eio (>= 1.0))
24
+
logs))
+632
lib/conpool.ml
+632
lib/conpool.ml
···
···
1
+
(** Conpool - Protocol-agnostic TCP/IP connection pooling library for Eio *)
2
+
3
+
let src = Logs.Src.create "conpool" ~doc:"Connection pooling library"
4
+
module Log = (val Logs.src_log src : Logs.LOG)
5
+
6
+
module Endpoint = struct
7
+
type t = {
8
+
host : string;
9
+
port : int;
10
+
}
11
+
12
+
let make ~host ~port = { host; port }
13
+
14
+
let host t = t.host
15
+
let port t = t.port
16
+
17
+
let pp fmt t =
18
+
Format.fprintf fmt "%s:%d" t.host t.port
19
+
20
+
let equal t1 t2 =
21
+
String.equal t1.host t2.host && t1.port = t2.port
22
+
23
+
let hash t =
24
+
Hashtbl.hash (t.host, t.port)
25
+
end
26
+
27
+
module Tls_config = struct
28
+
type t = {
29
+
config : Tls.Config.client;
30
+
servername : string option;
31
+
}
32
+
33
+
let make ~config ?servername () = { config; servername }
34
+
35
+
let config t = t.config
36
+
let servername t = t.servername
37
+
38
+
let pp fmt t =
39
+
Format.fprintf fmt "TLS(servername=%s)"
40
+
(match t.servername with Some s -> s | None -> "<default>")
41
+
end
42
+
43
+
(* Internal connection type - not exposed in public API *)
44
+
module Connection = struct
45
+
type t = {
46
+
flow : [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t;
47
+
created_at : float;
48
+
mutable last_used : float;
49
+
mutable use_count : int;
50
+
endpoint : Endpoint.t;
51
+
}
52
+
53
+
let flow t = t.flow
54
+
let endpoint t = t.endpoint
55
+
let created_at t = t.created_at
56
+
let last_used t = t.last_used
57
+
let use_count t = t.use_count
58
+
end
59
+
60
+
module Config = struct
61
+
type t = {
62
+
max_connections_per_endpoint : int;
63
+
max_idle_time : float;
64
+
max_connection_lifetime : float;
65
+
max_connection_uses : int option;
66
+
health_check : ([`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option;
67
+
connect_timeout : float option;
68
+
connect_retry_count : int;
69
+
connect_retry_delay : float;
70
+
on_connection_created : (Endpoint.t -> unit) option;
71
+
on_connection_closed : (Endpoint.t -> unit) option;
72
+
on_connection_reused : (Endpoint.t -> unit) option;
73
+
}
74
+
75
+
let make
76
+
?(max_connections_per_endpoint = 10)
77
+
?(max_idle_time = 60.0)
78
+
?(max_connection_lifetime = 300.0)
79
+
?max_connection_uses
80
+
?health_check
81
+
?(connect_timeout = 10.0)
82
+
?(connect_retry_count = 3)
83
+
?(connect_retry_delay = 0.1)
84
+
?on_connection_created
85
+
?on_connection_closed
86
+
?on_connection_reused
87
+
() =
88
+
{
89
+
max_connections_per_endpoint;
90
+
max_idle_time;
91
+
max_connection_lifetime;
92
+
max_connection_uses;
93
+
health_check;
94
+
connect_timeout = Some connect_timeout;
95
+
connect_retry_count;
96
+
connect_retry_delay;
97
+
on_connection_created;
98
+
on_connection_closed;
99
+
on_connection_reused;
100
+
}
101
+
102
+
let default = make ()
103
+
104
+
let max_connections_per_endpoint t = t.max_connections_per_endpoint
105
+
let max_idle_time t = t.max_idle_time
106
+
let max_connection_lifetime t = t.max_connection_lifetime
107
+
let max_connection_uses t = t.max_connection_uses
108
+
let health_check t = t.health_check
109
+
let connect_timeout t = t.connect_timeout
110
+
let connect_retry_count t = t.connect_retry_count
111
+
let connect_retry_delay t = t.connect_retry_delay
112
+
113
+
let pp fmt t =
114
+
Format.fprintf fmt
115
+
"@[<v>Config:@,\
116
+
- max_connections_per_endpoint: %d@,\
117
+
- max_idle_time: %.1fs@,\
118
+
- max_connection_lifetime: %.1fs@,\
119
+
- max_connection_uses: %s@,\
120
+
- connect_timeout: %s@,\
121
+
- connect_retry_count: %d@,\
122
+
- connect_retry_delay: %.2fs@]"
123
+
t.max_connections_per_endpoint
124
+
t.max_idle_time
125
+
t.max_connection_lifetime
126
+
(match t.max_connection_uses with Some n -> string_of_int n | None -> "unlimited")
127
+
(match t.connect_timeout with Some f -> Printf.sprintf "%.1fs" f | None -> "none")
128
+
t.connect_retry_count
129
+
t.connect_retry_delay
130
+
end
131
+
132
+
module Stats = struct
133
+
type t = {
134
+
active : int;
135
+
idle : int;
136
+
total_created : int;
137
+
total_reused : int;
138
+
total_closed : int;
139
+
errors : int;
140
+
}
141
+
142
+
let active t = t.active
143
+
let idle t = t.idle
144
+
let total_created t = t.total_created
145
+
let total_reused t = t.total_reused
146
+
let total_closed t = t.total_closed
147
+
let errors t = t.errors
148
+
149
+
let pp fmt t =
150
+
Format.fprintf fmt
151
+
"@[<v>Stats:@,\
152
+
- Active: %d@,\
153
+
- Idle: %d@,\
154
+
- Created: %d@,\
155
+
- Reused: %d@,\
156
+
- Closed: %d@,\
157
+
- Errors: %d@]"
158
+
t.active
159
+
t.idle
160
+
t.total_created
161
+
t.total_reused
162
+
t.total_closed
163
+
t.errors
164
+
end
165
+
166
+
type endp_stats = {
167
+
mutable active : int;
168
+
mutable idle : int;
169
+
mutable total_created : int;
170
+
mutable total_reused : int;
171
+
mutable total_closed : int;
172
+
mutable errors : int;
173
+
}
174
+
175
+
type endpoint_pool = {
176
+
pool : Connection.t Eio.Pool.t;
177
+
stats : endp_stats;
178
+
mutex : Eio.Mutex.t;
179
+
}
180
+
181
+
type ('clock, 'net) t = {
182
+
sw : Eio.Switch.t;
183
+
net : 'net;
184
+
clock : 'clock;
185
+
config : Config.t;
186
+
tls : Tls_config.t option;
187
+
endpoints : (Endpoint.t, endpoint_pool) Hashtbl.t;
188
+
endpoints_mutex : Eio.Mutex.t;
189
+
}
190
+
191
+
module EndpointTbl = Hashtbl.Make(struct
192
+
type t = Endpoint.t
193
+
let equal = Endpoint.equal
194
+
let hash = Endpoint.hash
195
+
end)
196
+
197
+
let get_time pool =
198
+
Eio.Time.now pool.clock
199
+
200
+
let create_endp_stats () = {
201
+
active = 0;
202
+
idle = 0;
203
+
total_created = 0;
204
+
total_reused = 0;
205
+
total_closed = 0;
206
+
errors = 0;
207
+
}
208
+
209
+
let snapshot_stats (stats : endp_stats) : Stats.t = {
210
+
active = stats.active;
211
+
idle = stats.idle;
212
+
total_created = stats.total_created;
213
+
total_reused = stats.total_reused;
214
+
total_closed = stats.total_closed;
215
+
errors = stats.errors;
216
+
}
217
+
218
+
(** {1 DNS Resolution} *)
219
+
220
+
let resolve_endpoint pool endpoint =
221
+
Log.debug (fun m -> m "Resolving %a..." Endpoint.pp endpoint);
222
+
let addrs = Eio.Net.getaddrinfo_stream pool.net (Endpoint.host endpoint) ~service:(string_of_int (Endpoint.port endpoint)) in
223
+
Log.debug (fun m -> m "Got address list for %a" Endpoint.pp endpoint);
224
+
match addrs with
225
+
| addr :: _ ->
226
+
Log.debug (fun m -> m "Resolved %a to %a"
227
+
Endpoint.pp endpoint Eio.Net.Sockaddr.pp addr);
228
+
addr
229
+
| [] ->
230
+
Log.err (fun m -> m "Failed to resolve hostname: %s" (Endpoint.host endpoint));
231
+
failwith (Printf.sprintf "Failed to resolve hostname: %s" (Endpoint.host endpoint))
232
+
233
+
(** {1 Connection Creation with Retry} *)
234
+
235
+
let rec create_connection_with_retry pool endpoint attempt =
236
+
if attempt > pool.config.connect_retry_count then begin
237
+
Log.err (fun m -> m "Failed to connect to %a after %d attempts"
238
+
Endpoint.pp endpoint pool.config.connect_retry_count);
239
+
failwith (Printf.sprintf "Failed to connect to %s:%d after %d attempts"
240
+
(Endpoint.host endpoint) (Endpoint.port endpoint) pool.config.connect_retry_count)
241
+
end;
242
+
243
+
Log.debug (fun m -> m "Connecting to %a (attempt %d/%d)"
244
+
Endpoint.pp endpoint attempt pool.config.connect_retry_count);
245
+
246
+
try
247
+
let addr = resolve_endpoint pool endpoint in
248
+
Log.debug (fun m -> m "Resolved %a to address" Endpoint.pp endpoint);
249
+
250
+
(* Connect with optional timeout *)
251
+
let socket =
252
+
match pool.config.connect_timeout with
253
+
| Some timeout ->
254
+
Eio.Time.with_timeout_exn pool.clock timeout
255
+
(fun () -> Eio.Net.connect ~sw:pool.sw pool.net addr)
256
+
| None ->
257
+
Eio.Net.connect ~sw:pool.sw pool.net addr
258
+
in
259
+
260
+
Log.debug (fun m -> m "TCP connection established to %a" Endpoint.pp endpoint);
261
+
262
+
let flow = match pool.tls with
263
+
| None -> (socket :> [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t)
264
+
| Some tls_cfg ->
265
+
Log.debug (fun m -> m "Initiating TLS handshake with %a" Endpoint.pp endpoint);
266
+
let host = match Tls_config.servername tls_cfg with
267
+
| Some name -> Domain_name.(host_exn (of_string_exn name))
268
+
| None -> Domain_name.(host_exn (of_string_exn (Endpoint.host endpoint)))
269
+
in
270
+
let tls_flow = Tls_eio.client_of_flow ~host (Tls_config.config tls_cfg) socket in
271
+
Log.info (fun m -> m "TLS connection established to %a" Endpoint.pp endpoint);
272
+
(tls_flow :> [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t)
273
+
in
274
+
275
+
let now = get_time pool in
276
+
Log.info (fun m -> m "Connection created to %a" Endpoint.pp endpoint);
277
+
{
278
+
Connection.flow;
279
+
created_at = now;
280
+
last_used = now;
281
+
use_count = 0;
282
+
endpoint;
283
+
}
284
+
285
+
with
286
+
| Eio.Time.Timeout ->
287
+
Log.warn (fun m -> m "Connection timeout to %a (attempt %d)" Endpoint.pp endpoint attempt);
288
+
(* Exponential backoff *)
289
+
let delay = pool.config.connect_retry_delay *. (2.0 ** float_of_int (attempt - 1)) in
290
+
Eio.Time.sleep pool.clock delay;
291
+
create_connection_with_retry pool endpoint (attempt + 1)
292
+
| e ->
293
+
(* Other errors - retry with backoff *)
294
+
Log.warn (fun m -> m "Connection attempt %d to %a failed: %s"
295
+
attempt Endpoint.pp endpoint (Printexc.to_string e));
296
+
if attempt < pool.config.connect_retry_count then (
297
+
let delay = pool.config.connect_retry_delay *. (2.0 ** float_of_int (attempt - 1)) in
298
+
Eio.Time.sleep pool.clock delay;
299
+
create_connection_with_retry pool endpoint (attempt + 1)
300
+
) else
301
+
raise e
302
+
303
+
let create_connection pool endpoint =
304
+
create_connection_with_retry pool endpoint 1
305
+
306
+
(** {1 Connection Validation} *)
307
+
308
+
let is_healthy pool ?(check_readable = false) conn =
309
+
let now = get_time pool in
310
+
311
+
(* Check age *)
312
+
let age = now -. Connection.created_at conn in
313
+
if age > pool.config.max_connection_lifetime then begin
314
+
Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max lifetime (%.2fs > %.2fs)"
315
+
Endpoint.pp (Connection.endpoint conn) age pool.config.max_connection_lifetime);
316
+
false
317
+
end
318
+
319
+
(* Check idle time *)
320
+
else if (now -. Connection.last_used conn) > pool.config.max_idle_time then begin
321
+
let idle_time = now -. Connection.last_used conn in
322
+
Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max idle time (%.2fs > %.2fs)"
323
+
Endpoint.pp (Connection.endpoint conn) idle_time pool.config.max_idle_time);
324
+
false
325
+
end
326
+
327
+
(* Check use count *)
328
+
else if (match pool.config.max_connection_uses with
329
+
| Some max -> Connection.use_count conn >= max
330
+
| None -> false) then begin
331
+
Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max use count (%d)"
332
+
Endpoint.pp (Connection.endpoint conn) (Connection.use_count conn));
333
+
false
334
+
end
335
+
336
+
(* Optional: custom health check *)
337
+
else if (match pool.config.health_check with
338
+
| Some check ->
339
+
(try
340
+
let healthy = check (Connection.flow conn) in
341
+
if not healthy then
342
+
Log.debug (fun m -> m "Connection to %a failed custom health check"
343
+
Endpoint.pp (Connection.endpoint conn));
344
+
not healthy
345
+
with e ->
346
+
Log.debug (fun m -> m "Connection to %a health check raised exception: %s"
347
+
Endpoint.pp (Connection.endpoint conn) (Printexc.to_string e));
348
+
true) (* Exception in health check = unhealthy *)
349
+
| None -> false) then
350
+
false
351
+
352
+
(* Optional: check if socket still connected *)
353
+
else if check_readable then
354
+
try
355
+
(* TODO avsm: a sockopt for this? *)
356
+
true
357
+
with
358
+
| _ -> false
359
+
360
+
else begin
361
+
Log.debug (fun m -> m "Connection to %a is healthy (age=%.2fs, idle=%.2fs, uses=%d)"
362
+
Endpoint.pp (Connection.endpoint conn)
363
+
age
364
+
(now -. Connection.last_used conn)
365
+
(Connection.use_count conn));
366
+
true
367
+
end
368
+
369
+
(** {1 Internal Pool Operations} *)
370
+
371
+
let close_internal pool conn =
372
+
Log.debug (fun m -> m "Closing connection to %a (age=%.2fs, uses=%d)"
373
+
Endpoint.pp (Connection.endpoint conn)
374
+
(get_time pool -. Connection.created_at conn)
375
+
(Connection.use_count conn));
376
+
377
+
Eio.Cancel.protect (fun () ->
378
+
try
379
+
Eio.Flow.close (Connection.flow conn)
380
+
with _ -> ()
381
+
);
382
+
383
+
(* Call hook if configured *)
384
+
Option.iter (fun f -> f (Connection.endpoint conn)) pool.config.on_connection_closed
385
+
386
+
let get_or_create_endpoint_pool pool endpoint =
387
+
Log.debug (fun m -> m "Getting or creating endpoint pool for %a" Endpoint.pp endpoint);
388
+
389
+
(* First try with read lock *)
390
+
match Eio.Mutex.use_ro pool.endpoints_mutex (fun () ->
391
+
Hashtbl.find_opt pool.endpoints endpoint
392
+
) with
393
+
| Some ep_pool ->
394
+
Log.debug (fun m -> m "Found existing endpoint pool for %a" Endpoint.pp endpoint);
395
+
ep_pool
396
+
| None ->
397
+
Log.debug (fun m -> m "No existing pool, need to create for %a" Endpoint.pp endpoint);
398
+
(* Need to create - use write lock *)
399
+
Eio.Mutex.use_rw ~protect:true pool.endpoints_mutex (fun () ->
400
+
(* Check again in case another fiber created it *)
401
+
match Hashtbl.find_opt pool.endpoints endpoint with
402
+
| Some ep_pool ->
403
+
Log.debug (fun m -> m "Another fiber created pool for %a" Endpoint.pp endpoint);
404
+
ep_pool
405
+
| None ->
406
+
(* Create new endpoint pool *)
407
+
let stats = create_endp_stats () in
408
+
let mutex = Eio.Mutex.create () in
409
+
410
+
Log.info (fun m -> m "Creating new endpoint pool for %a (max_connections=%d)"
411
+
Endpoint.pp endpoint pool.config.max_connections_per_endpoint);
412
+
413
+
Log.debug (fun m -> m "About to create Eio.Pool for %a" Endpoint.pp endpoint);
414
+
415
+
let eio_pool = Eio.Pool.create
416
+
pool.config.max_connections_per_endpoint
417
+
~validate:(fun conn ->
418
+
Log.debug (fun m -> m "Validate called for connection to %a" Endpoint.pp endpoint);
419
+
(* Called before reusing from pool *)
420
+
let healthy = is_healthy pool ~check_readable:false conn in
421
+
422
+
if healthy then (
423
+
Log.debug (fun m -> m "Reusing connection to %a from pool" Endpoint.pp endpoint);
424
+
425
+
(* Update stats for reuse *)
426
+
Eio.Mutex.use_rw ~protect:true mutex (fun () ->
427
+
stats.total_reused <- stats.total_reused + 1
428
+
);
429
+
430
+
(* Call hook if configured *)
431
+
Option.iter (fun f -> f endpoint) pool.config.on_connection_reused;
432
+
433
+
(* Run health check if configured *)
434
+
match pool.config.health_check with
435
+
| Some check ->
436
+
(try check (Connection.flow conn)
437
+
with _ -> false)
438
+
| None -> true
439
+
) else begin
440
+
Log.debug (fun m -> m "Connection to %a failed validation, creating new one" Endpoint.pp endpoint);
441
+
false
442
+
end
443
+
)
444
+
~dispose:(fun conn ->
445
+
(* Called when removing from pool *)
446
+
Eio.Cancel.protect (fun () ->
447
+
close_internal pool conn;
448
+
449
+
(* Update stats *)
450
+
Eio.Mutex.use_rw ~protect:true mutex (fun () ->
451
+
stats.total_closed <- stats.total_closed + 1
452
+
)
453
+
)
454
+
)
455
+
(fun () ->
456
+
Log.debug (fun m -> m "Factory function called for %a" Endpoint.pp endpoint);
457
+
try
458
+
let conn = create_connection pool endpoint in
459
+
460
+
Log.debug (fun m -> m "Connection created successfully for %a" Endpoint.pp endpoint);
461
+
462
+
(* Update stats *)
463
+
Eio.Mutex.use_rw ~protect:true mutex (fun () ->
464
+
stats.total_created <- stats.total_created + 1
465
+
);
466
+
467
+
(* Call hook if configured *)
468
+
Option.iter (fun f -> f endpoint) pool.config.on_connection_created;
469
+
470
+
conn
471
+
with e ->
472
+
Log.err (fun m -> m "Factory function failed for %a: %s"
473
+
Endpoint.pp endpoint (Printexc.to_string e));
474
+
(* Update error stats *)
475
+
Eio.Mutex.use_rw ~protect:true mutex (fun () ->
476
+
stats.errors <- stats.errors + 1
477
+
);
478
+
raise e
479
+
)
480
+
in
481
+
482
+
Log.debug (fun m -> m "Eio.Pool created successfully for %a" Endpoint.pp endpoint);
483
+
484
+
let ep_pool = {
485
+
pool = eio_pool;
486
+
stats;
487
+
mutex;
488
+
} in
489
+
490
+
Hashtbl.add pool.endpoints endpoint ep_pool;
491
+
Log.debug (fun m -> m "Endpoint pool added to hashtable for %a" Endpoint.pp endpoint);
492
+
ep_pool
493
+
)
494
+
495
+
(** {1 Public API - Pool Creation} *)
496
+
497
+
let create ~sw ~(net : 'net Eio.Net.t) ~(clock : 'clock Eio.Time.clock) ?tls ?(config = Config.default) () : ('clock Eio.Time.clock, 'net Eio.Net.t) t =
498
+
Log.info (fun m -> m "Creating new connection pool (max_per_endpoint=%d, max_idle=%.1fs, max_lifetime=%.1fs)"
499
+
config.max_connections_per_endpoint
500
+
config.max_idle_time
501
+
config.max_connection_lifetime);
502
+
503
+
let pool = {
504
+
sw;
505
+
net;
506
+
clock;
507
+
config;
508
+
tls;
509
+
endpoints = Hashtbl.create 16;
510
+
endpoints_mutex = Eio.Mutex.create ();
511
+
} in
512
+
513
+
(* Auto-cleanup on switch release *)
514
+
Eio.Switch.on_release sw (fun () ->
515
+
Eio.Cancel.protect (fun () ->
516
+
Log.info (fun m -> m "Closing connection pool");
517
+
(* Close all idle connections - active ones will be cleaned up by switch *)
518
+
Hashtbl.iter (fun _endpoint _ep_pool ->
519
+
(* Connections are bound to the switch and will be auto-closed *)
520
+
()
521
+
) pool.endpoints;
522
+
523
+
Hashtbl.clear pool.endpoints
524
+
)
525
+
);
526
+
527
+
pool
528
+
529
+
(** {1 Public API - Connection Management} *)
530
+
531
+
let with_connection (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint f =
532
+
Log.debug (fun m -> m "Acquiring connection to %a" Endpoint.pp endpoint);
533
+
let ep_pool = get_or_create_endpoint_pool pool endpoint in
534
+
535
+
(* Increment active count *)
536
+
Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->
537
+
ep_pool.stats.active <- ep_pool.stats.active + 1
538
+
);
539
+
540
+
Fun.protect
541
+
~finally:(fun () ->
542
+
(* Decrement active count *)
543
+
Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->
544
+
ep_pool.stats.active <- ep_pool.stats.active - 1
545
+
);
546
+
Log.debug (fun m -> m "Released connection to %a" Endpoint.pp endpoint)
547
+
)
548
+
(fun () ->
549
+
(* Use Eio.Pool for resource management *)
550
+
Eio.Pool.use ep_pool.pool (fun conn ->
551
+
Log.debug (fun m -> m "Using connection to %a (uses=%d)"
552
+
Endpoint.pp endpoint (Connection.use_count conn));
553
+
554
+
(* Update last used time and use count *)
555
+
conn.last_used <- get_time pool;
556
+
conn.use_count <- conn.use_count + 1;
557
+
558
+
(* Update idle stats (connection taken from idle pool) *)
559
+
Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->
560
+
ep_pool.stats.idle <- max 0 (ep_pool.stats.idle - 1)
561
+
);
562
+
563
+
try
564
+
let result = f conn.flow in
565
+
566
+
(* Success - connection will be returned to pool by Eio.Pool *)
567
+
(* Update idle stats (connection returned to idle pool) *)
568
+
Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->
569
+
ep_pool.stats.idle <- ep_pool.stats.idle + 1
570
+
);
571
+
572
+
result
573
+
with e ->
574
+
(* Error - close connection so it won't be reused *)
575
+
Log.warn (fun m -> m "Error using connection to %a: %s"
576
+
Endpoint.pp endpoint (Printexc.to_string e));
577
+
close_internal pool conn;
578
+
579
+
(* Update error stats *)
580
+
Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->
581
+
ep_pool.stats.errors <- ep_pool.stats.errors + 1
582
+
);
583
+
584
+
raise e
585
+
)
586
+
)
587
+
588
+
(** {1 Public API - Statistics} *)
589
+
590
+
let stats (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint =
591
+
match Hashtbl.find_opt pool.endpoints endpoint with
592
+
| Some ep_pool ->
593
+
Eio.Mutex.use_ro ep_pool.mutex (fun () ->
594
+
snapshot_stats ep_pool.stats
595
+
)
596
+
| None ->
597
+
(* No pool for this endpoint yet *)
598
+
{
599
+
Stats.active = 0;
600
+
idle = 0;
601
+
total_created = 0;
602
+
total_reused = 0;
603
+
total_closed = 0;
604
+
errors = 0;
605
+
}
606
+
607
+
let all_stats (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) =
608
+
Eio.Mutex.use_ro pool.endpoints_mutex (fun () ->
609
+
Hashtbl.fold (fun endpoint ep_pool acc ->
610
+
let stats = Eio.Mutex.use_ro ep_pool.mutex (fun () ->
611
+
snapshot_stats ep_pool.stats
612
+
) in
613
+
(endpoint, stats) :: acc
614
+
) pool.endpoints []
615
+
)
616
+
617
+
(** {1 Public API - Pool Management} *)
618
+
619
+
let clear_endpoint (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint =
620
+
Log.info (fun m -> m "Clearing endpoint %a from pool" Endpoint.pp endpoint);
621
+
match Hashtbl.find_opt pool.endpoints endpoint with
622
+
| Some _ep_pool ->
623
+
Eio.Cancel.protect (fun () ->
624
+
(* Remove endpoint pool from hashtable *)
625
+
(* Idle connections will be discarded *)
626
+
(* Active connections will be closed when returned *)
627
+
Eio.Mutex.use_rw ~protect:true pool.endpoints_mutex (fun () ->
628
+
Hashtbl.remove pool.endpoints endpoint
629
+
)
630
+
)
631
+
| None ->
632
+
Log.debug (fun m -> m "No endpoint pool found for %a" Endpoint.pp endpoint)
+213
lib/conpool.mli
+213
lib/conpool.mli
···
···
1
+
(** Conpool - Protocol-agnostic TCP/IP connection pooling library for Eio *)
2
+
3
+
(** {1 Logging} *)
4
+
5
+
val src : Logs.Src.t
6
+
(** Logs source for conpool. Configure logging with:
7
+
{[
8
+
Logs.Src.set_level Conpool.src (Some Logs.Debug);
9
+
Logs.set_reporter (Logs_fmt.reporter ());
10
+
]}
11
+
*)
12
+
13
+
(** {1 Core Types} *)
14
+
15
+
(** Network endpoint *)
16
+
module Endpoint : sig
17
+
type t
18
+
(** Network endpoint identified by host and port *)
19
+
20
+
val make : host:string -> port:int -> t
21
+
(** Create an endpoint *)
22
+
23
+
val host : t -> string
24
+
(** Get the hostname *)
25
+
26
+
val port : t -> int
27
+
(** Get the port number *)
28
+
29
+
val pp : Format.formatter -> t -> unit
30
+
(** Pretty-print an endpoint *)
31
+
32
+
val equal : t -> t -> bool
33
+
(** Compare two endpoints for equality *)
34
+
35
+
val hash : t -> int
36
+
(** Hash an endpoint *)
37
+
end
38
+
39
+
(** TLS configuration *)
40
+
module Tls_config : sig
41
+
type t
42
+
(** TLS configuration applied to all connections in a pool *)
43
+
44
+
val make : config:Tls.Config.client -> ?servername:string -> unit -> t
45
+
(** Create TLS configuration.
46
+
@param config TLS client configuration
47
+
@param servername Optional SNI server name override. If None, uses endpoint host *)
48
+
49
+
val config : t -> Tls.Config.client
50
+
(** Get the TLS client configuration *)
51
+
52
+
val servername : t -> string option
53
+
(** Get the SNI server name override *)
54
+
55
+
val pp : Format.formatter -> t -> unit
56
+
(** Pretty-print TLS configuration *)
57
+
end
58
+
59
+
60
+
(** Pool configuration *)
61
+
module Config : sig
62
+
type t
63
+
(** Pool configuration *)
64
+
65
+
val make :
66
+
?max_connections_per_endpoint:int ->
67
+
?max_idle_time:float ->
68
+
?max_connection_lifetime:float ->
69
+
?max_connection_uses:int ->
70
+
?health_check:([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) ->
71
+
?connect_timeout:float ->
72
+
?connect_retry_count:int ->
73
+
?connect_retry_delay:float ->
74
+
?on_connection_created:(Endpoint.t -> unit) ->
75
+
?on_connection_closed:(Endpoint.t -> unit) ->
76
+
?on_connection_reused:(Endpoint.t -> unit) ->
77
+
unit -> t
78
+
(** Create pool configuration with optional parameters.
79
+
See field descriptions for defaults. *)
80
+
81
+
val default : t
82
+
(** Sensible defaults for most use cases:
83
+
- max_connections_per_endpoint: 10
84
+
- max_idle_time: 60.0s
85
+
- max_connection_lifetime: 300.0s
86
+
- max_connection_uses: None (unlimited)
87
+
- health_check: None
88
+
- connect_timeout: 10.0s
89
+
- connect_retry_count: 3
90
+
- connect_retry_delay: 0.1s
91
+
- hooks: None *)
92
+
93
+
val max_connections_per_endpoint : t -> int
94
+
val max_idle_time : t -> float
95
+
val max_connection_lifetime : t -> float
96
+
val max_connection_uses : t -> int option
97
+
val health_check : t -> ([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option
98
+
val connect_timeout : t -> float option
99
+
val connect_retry_count : t -> int
100
+
val connect_retry_delay : t -> float
101
+
102
+
val pp : Format.formatter -> t -> unit
103
+
(** Pretty-print configuration *)
104
+
end
105
+
106
+
(** Statistics for an endpoint *)
107
+
module Stats : sig
108
+
type t
109
+
(** Statistics for a specific endpoint *)
110
+
111
+
val active : t -> int
112
+
(** Connections currently in use *)
113
+
114
+
val idle : t -> int
115
+
(** Connections in pool waiting to be reused *)
116
+
117
+
val total_created : t -> int
118
+
(** Total connections created (lifetime) *)
119
+
120
+
val total_reused : t -> int
121
+
(** Total times connections were reused *)
122
+
123
+
val total_closed : t -> int
124
+
(** Total connections closed *)
125
+
126
+
val errors : t -> int
127
+
(** Total connection errors *)
128
+
129
+
val pp : Format.formatter -> t -> unit
130
+
(** Pretty-print endpoint statistics *)
131
+
end
132
+
133
+
(** {1 Connection Pool} *)
134
+
135
+
type ('clock, 'net) t
136
+
(** Connection pool managing multiple endpoints, parameterized by clock and network types *)
137
+
138
+
val create :
139
+
sw:Eio.Switch.t ->
140
+
net:'net Eio.Net.t ->
141
+
clock:'clock Eio.Time.clock ->
142
+
?tls:Tls_config.t ->
143
+
?config:Config.t ->
144
+
unit -> ('clock Eio.Time.clock, 'net Eio.Net.t) t
145
+
(** Create connection pool bound to switch.
146
+
All connections will be closed when switch is released.
147
+
148
+
@param sw Switch for resource management
149
+
@param net Network interface for creating connections
150
+
@param clock Clock for timeouts and time-based validation
151
+
@param tls Optional TLS configuration applied to all connections
152
+
@param config Optional pool configuration (uses Config.default if not provided) *)
153
+
154
+
(** {1 Connection Usage} *)
155
+
156
+
val with_connection :
157
+
('clock Eio.Time.clock, 'net Eio.Net.t) t ->
158
+
Endpoint.t ->
159
+
([ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t -> 'a) ->
160
+
'a
161
+
(** Acquire connection, use it, automatically release back to pool.
162
+
163
+
This is the only way to use connections from the pool. All resource management
164
+
is handled automatically through Eio's switch mechanism.
165
+
166
+
If idle connection available and healthy:
167
+
- Reuse from pool (validates health first)
168
+
Else:
169
+
- Create new connection (may block if endpoint at limit)
170
+
171
+
On success: connection returned to pool for reuse
172
+
On error: connection closed, not returned to pool
173
+
174
+
Example:
175
+
{[
176
+
let endpoint = Conpool.Endpoint.make ~host:"example.com" ~port:443 in
177
+
Conpool.with_connection pool endpoint (fun conn ->
178
+
(* Use conn for HTTP request, Redis command, etc. *)
179
+
Eio.Flow.copy_string "GET / HTTP/1.1\r\n\r\n" conn;
180
+
let buf = Eio.Buf_read.of_flow conn ~max_size:4096 in
181
+
Eio.Buf_read.take_all buf
182
+
)
183
+
]}
184
+
*)
185
+
186
+
(** {1 Statistics & Monitoring} *)
187
+
188
+
val stats :
189
+
('clock Eio.Time.clock, 'net Eio.Net.t) t ->
190
+
Endpoint.t ->
191
+
Stats.t
192
+
(** Get statistics for specific endpoint *)
193
+
194
+
val all_stats :
195
+
('clock Eio.Time.clock, 'net Eio.Net.t) t ->
196
+
(Endpoint.t * Stats.t) list
197
+
(** Get statistics for all endpoints in pool *)
198
+
199
+
(** {1 Pool Management} *)
200
+
201
+
val clear_endpoint :
202
+
('clock Eio.Time.clock, 'net Eio.Net.t) t ->
203
+
Endpoint.t ->
204
+
unit
205
+
(** Clear all cached connections for a specific endpoint.
206
+
207
+
This removes the endpoint from the pool, discarding all idle connections.
208
+
Active connections will continue to work but won't be returned to the pool.
209
+
210
+
Use this when you know an endpoint's connections are no longer valid
211
+
(e.g., server restarted, network reconfigured, credentials changed).
212
+
213
+
The pool will be automatically cleaned up when its switch is released. *)