+1

.gitignore

··· 1 1 + _build

+33

conpool.opam

··· 1 1 + # This file is generated by dune, edit dune-project instead 2 2 + opam-version: "2.0" 3 3 + synopsis: "Protocol-agnostic TCP/IP connection pooling library for Eio" 4 4 + description: 5 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 6 + maintainer: ["Your Name"] 7 7 + authors: ["Your Name"] 8 8 + license: "MIT" 9 9 + homepage: "https://github.com/username/conpool" 10 10 + bug-reports: "https://github.com/username/conpool/issues" 11 11 + depends: [ 12 12 + "ocaml" 13 13 + "dune" {>= "3.0" & >= "3.0"} 14 14 + "eio" 15 15 + "tls-eio" {>= "1.0"} 16 16 + "logs" 17 17 + "odoc" {with-doc} 18 18 + ] 19 19 + build: [ 20 20 + ["dune" "subst"] {dev} 21 21 + [ 22 22 + "dune" 23 23 + "build" 24 24 + "-p" 25 25 + name 26 26 + "-j" 27 27 + jobs 28 28 + "@install" 29 29 + "@runtest" {with-test} 30 30 + "@doc" {with-doc} 31 31 + ] 32 32 + ] 33 33 + dev-repo: "git+https://github.com/username/conpool.git"

+24

dune-project

··· 1 1 + (lang dune 3.0) 2 2 + (name conpool) 3 3 + 4 4 + (generate_opam_files true) 5 5 + 6 6 + (source 7 7 + (github username/conpool)) 8 8 + 9 9 + (authors "Your Name") 10 10 + 11 11 + (maintainers "Your Name") 12 12 + 13 13 + (license MIT) 14 14 + 15 15 + (package 16 16 + (name conpool) 17 17 + (synopsis "Protocol-agnostic TCP/IP connection pooling library for Eio") 18 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 19 + (depends 20 20 + ocaml 21 21 + (dune (>= 3.0)) 22 22 + eio 23 23 + (tls-eio (>= 1.0)) 24 24 + logs))

+632

lib/conpool.ml

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

+213

lib/conpool.mli

··· 1 1 + (** Conpool - Protocol-agnostic TCP/IP connection pooling library for Eio *) 2 2 + 3 3 + (** {1 Logging} *) 4 4 + 5 5 + val src : Logs.Src.t 6 6 + (** Logs source for conpool. Configure logging with: 7 7 + {[ 8 8 + Logs.Src.set_level Conpool.src (Some Logs.Debug); 9 9 + Logs.set_reporter (Logs_fmt.reporter ()); 10 10 + ]} 11 11 + *) 12 12 + 13 13 + (** {1 Core Types} *) 14 14 + 15 15 + (** Network endpoint *) 16 16 + module Endpoint : sig 17 17 + type t 18 18 + (** Network endpoint identified by host and port *) 19 19 + 20 20 + val make : host:string -> port:int -> t 21 21 + (** Create an endpoint *) 22 22 + 23 23 + val host : t -> string 24 24 + (** Get the hostname *) 25 25 + 26 26 + val port : t -> int 27 27 + (** Get the port number *) 28 28 + 29 29 + val pp : Format.formatter -> t -> unit 30 30 + (** Pretty-print an endpoint *) 31 31 + 32 32 + val equal : t -> t -> bool 33 33 + (** Compare two endpoints for equality *) 34 34 + 35 35 + val hash : t -> int 36 36 + (** Hash an endpoint *) 37 37 + end 38 38 + 39 39 + (** TLS configuration *) 40 40 + module Tls_config : sig 41 41 + type t 42 42 + (** TLS configuration applied to all connections in a pool *) 43 43 + 44 44 + val make : config:Tls.Config.client -> ?servername:string -> unit -> t 45 45 + (** Create TLS configuration. 46 46 + @param config TLS client configuration 47 47 + @param servername Optional SNI server name override. If None, uses endpoint host *) 48 48 + 49 49 + val config : t -> Tls.Config.client 50 50 + (** Get the TLS client configuration *) 51 51 + 52 52 + val servername : t -> string option 53 53 + (** Get the SNI server name override *) 54 54 + 55 55 + val pp : Format.formatter -> t -> unit 56 56 + (** Pretty-print TLS configuration *) 57 57 + end 58 58 + 59 59 + 60 60 + (** Pool configuration *) 61 61 + module Config : sig 62 62 + type t 63 63 + (** Pool configuration *) 64 64 + 65 65 + val make : 66 66 + ?max_connections_per_endpoint:int -> 67 67 + ?max_idle_time:float -> 68 68 + ?max_connection_lifetime:float -> 69 69 + ?max_connection_uses:int -> 70 70 + ?health_check:([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) -> 71 71 + ?connect_timeout:float -> 72 72 + ?connect_retry_count:int -> 73 73 + ?connect_retry_delay:float -> 74 74 + ?on_connection_created:(Endpoint.t -> unit) -> 75 75 + ?on_connection_closed:(Endpoint.t -> unit) -> 76 76 + ?on_connection_reused:(Endpoint.t -> unit) -> 77 77 + unit -> t 78 78 + (** Create pool configuration with optional parameters. 79 79 + See field descriptions for defaults. *) 80 80 + 81 81 + val default : t 82 82 + (** Sensible defaults for most use cases: 83 83 + - max_connections_per_endpoint: 10 84 84 + - max_idle_time: 60.0s 85 85 + - max_connection_lifetime: 300.0s 86 86 + - max_connection_uses: None (unlimited) 87 87 + - health_check: None 88 88 + - connect_timeout: 10.0s 89 89 + - connect_retry_count: 3 90 90 + - connect_retry_delay: 0.1s 91 91 + - hooks: None *) 92 92 + 93 93 + val max_connections_per_endpoint : t -> int 94 94 + val max_idle_time : t -> float 95 95 + val max_connection_lifetime : t -> float 96 96 + val max_connection_uses : t -> int option 97 97 + val health_check : t -> ([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option 98 98 + val connect_timeout : t -> float option 99 99 + val connect_retry_count : t -> int 100 100 + val connect_retry_delay : t -> float 101 101 + 102 102 + val pp : Format.formatter -> t -> unit 103 103 + (** Pretty-print configuration *) 104 104 + end 105 105 + 106 106 + (** Statistics for an endpoint *) 107 107 + module Stats : sig 108 108 + type t 109 109 + (** Statistics for a specific endpoint *) 110 110 + 111 111 + val active : t -> int 112 112 + (** Connections currently in use *) 113 113 + 114 114 + val idle : t -> int 115 115 + (** Connections in pool waiting to be reused *) 116 116 + 117 117 + val total_created : t -> int 118 118 + (** Total connections created (lifetime) *) 119 119 + 120 120 + val total_reused : t -> int 121 121 + (** Total times connections were reused *) 122 122 + 123 123 + val total_closed : t -> int 124 124 + (** Total connections closed *) 125 125 + 126 126 + val errors : t -> int 127 127 + (** Total connection errors *) 128 128 + 129 129 + val pp : Format.formatter -> t -> unit 130 130 + (** Pretty-print endpoint statistics *) 131 131 + end 132 132 + 133 133 + (** {1 Connection Pool} *) 134 134 + 135 135 + type ('clock, 'net) t 136 136 + (** Connection pool managing multiple endpoints, parameterized by clock and network types *) 137 137 + 138 138 + val create : 139 139 + sw:Eio.Switch.t -> 140 140 + net:'net Eio.Net.t -> 141 141 + clock:'clock Eio.Time.clock -> 142 142 + ?tls:Tls_config.t -> 143 143 + ?config:Config.t -> 144 144 + unit -> ('clock Eio.Time.clock, 'net Eio.Net.t) t 145 145 + (** Create connection pool bound to switch. 146 146 + All connections will be closed when switch is released. 147 147 + 148 148 + @param sw Switch for resource management 149 149 + @param net Network interface for creating connections 150 150 + @param clock Clock for timeouts and time-based validation 151 151 + @param tls Optional TLS configuration applied to all connections 152 152 + @param config Optional pool configuration (uses Config.default if not provided) *) 153 153 + 154 154 + (** {1 Connection Usage} *) 155 155 + 156 156 + val with_connection : 157 157 + ('clock Eio.Time.clock, 'net Eio.Net.t) t -> 158 158 + Endpoint.t -> 159 159 + ([ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t -> 'a) -> 160 160 + 'a 161 161 + (** Acquire connection, use it, automatically release back to pool. 162 162 + 163 163 + This is the only way to use connections from the pool. All resource management 164 164 + is handled automatically through Eio's switch mechanism. 165 165 + 166 166 + If idle connection available and healthy: 167 167 + - Reuse from pool (validates health first) 168 168 + Else: 169 169 + - Create new connection (may block if endpoint at limit) 170 170 + 171 171 + On success: connection returned to pool for reuse 172 172 + On error: connection closed, not returned to pool 173 173 + 174 174 + Example: 175 175 + {[ 176 176 + let endpoint = Conpool.Endpoint.make ~host:"example.com" ~port:443 in 177 177 + Conpool.with_connection pool endpoint (fun conn -> 178 178 + (* Use conn for HTTP request, Redis command, etc. *) 179 179 + Eio.Flow.copy_string "GET / HTTP/1.1\r\n\r\n" conn; 180 180 + let buf = Eio.Buf_read.of_flow conn ~max_size:4096 in 181 181 + Eio.Buf_read.take_all buf 182 182 + ) 183 183 + ]} 184 184 + *) 185 185 + 186 186 + (** {1 Statistics & Monitoring} *) 187 187 + 188 188 + val stats : 189 189 + ('clock Eio.Time.clock, 'net Eio.Net.t) t -> 190 190 + Endpoint.t -> 191 191 + Stats.t 192 192 + (** Get statistics for specific endpoint *) 193 193 + 194 194 + val all_stats : 195 195 + ('clock Eio.Time.clock, 'net Eio.Net.t) t -> 196 196 + (Endpoint.t * Stats.t) list 197 197 + (** Get statistics for all endpoints in pool *) 198 198 + 199 199 + (** {1 Pool Management} *) 200 200 + 201 201 + val clear_endpoint : 202 202 + ('clock Eio.Time.clock, 'net Eio.Net.t) t -> 203 203 + Endpoint.t -> 204 204 + unit 205 205 + (** Clear all cached connections for a specific endpoint. 206 206 + 207 207 + This removes the endpoint from the pool, discarding all idle connections. 208 208 + Active connections will continue to work but won't be returned to the pool. 209 209 + 210 210 + Use this when you know an endpoint's connections are no longer valid 211 211 + (e.g., server restarted, network reconfigured, credentials changed). 212 212 + 213 213 + The pool will be automatically cleaned up when its switch is released. *)

+4

lib/dune

··· 1 1 + (library 2 2 + (name conpool) 3 3 + (public_name conpool) 4 4 + (libraries eio eio.unix tls-eio logs))