TCP/TLS connection pooling for Eio

split out modules

+635 -374
+2
conpool.opam
··· 14 14 "eio" 15 15 "tls-eio" {>= "1.0"} 16 16 "logs" 17 + "fmt" 18 + "cmdliner" 17 19 "odoc" {with-doc} 18 20 ] 19 21 build: [
+3 -1
dune-project
··· 21 21 (dune (>= 3.0)) 22 22 eio 23 23 (tls-eio (>= 1.0)) 24 - logs)) 24 + logs 25 + fmt 26 + cmdliner))
+52
lib/cmd.ml
··· 1 + (** Cmdliner terms for connection pool configuration *) 2 + 3 + open Cmdliner 4 + 5 + let max_connections_per_endpoint = 6 + let doc = "Maximum concurrent connections per endpoint." in 7 + Arg.(value & opt int 10 & info ["max-connections-per-endpoint"] ~doc ~docv:"NUM") 8 + 9 + let max_idle_time = 10 + let doc = "Maximum time a connection can sit idle in seconds." in 11 + Arg.(value & opt float 60.0 & info ["max-idle-time"] ~doc ~docv:"SECONDS") 12 + 13 + let max_connection_lifetime = 14 + let doc = "Maximum connection age in seconds." in 15 + Arg.(value & opt float 300.0 & info ["max-connection-lifetime"] ~doc ~docv:"SECONDS") 16 + 17 + let max_connection_uses = 18 + let doc = "Maximum times a connection can be reused (omit for unlimited)." in 19 + Arg.(value & opt (some int) None & info ["max-connection-uses"] ~doc ~docv:"NUM") 20 + 21 + let connect_timeout = 22 + let doc = "Connection timeout in seconds." in 23 + Arg.(value & opt float 10.0 & info ["connect-timeout"] ~doc ~docv:"SECONDS") 24 + 25 + let connect_retry_count = 26 + let doc = "Number of connection retry attempts." in 27 + Arg.(value & opt int 3 & info ["connect-retry-count"] ~doc ~docv:"NUM") 28 + 29 + let connect_retry_delay = 30 + let doc = "Initial retry delay in seconds (with exponential backoff)." in 31 + Arg.(value & opt float 0.1 & info ["connect-retry-delay"] ~doc ~docv:"SECONDS") 32 + 33 + let config = 34 + let make max_conn max_idle max_lifetime max_uses timeout retry_count retry_delay = 35 + Config.make 36 + ~max_connections_per_endpoint:max_conn 37 + ~max_idle_time:max_idle 38 + ~max_connection_lifetime:max_lifetime 39 + ?max_connection_uses:max_uses 40 + ~connect_timeout:timeout 41 + ~connect_retry_count:retry_count 42 + ~connect_retry_delay:retry_delay 43 + () 44 + in 45 + Term.(const make 46 + $ max_connections_per_endpoint 47 + $ max_idle_time 48 + $ max_connection_lifetime 49 + $ max_connection_uses 50 + $ connect_timeout 51 + $ connect_retry_count 52 + $ connect_retry_delay)
+45
lib/cmd.mli
··· 1 + (** Cmdliner terms for connection pool configuration *) 2 + 3 + (** {1 Configuration Terms} *) 4 + 5 + val max_connections_per_endpoint : int Cmdliner.Term.t 6 + (** Cmdliner term for maximum connections per endpoint. 7 + Default: 10 8 + Flag: [--max-connections-per-endpoint] *) 9 + 10 + val max_idle_time : float Cmdliner.Term.t 11 + (** Cmdliner term for maximum idle time in seconds. 12 + Default: 60.0 13 + Flag: [--max-idle-time] *) 14 + 15 + val max_connection_lifetime : float Cmdliner.Term.t 16 + (** Cmdliner term for maximum connection lifetime in seconds. 17 + Default: 300.0 18 + Flag: [--max-connection-lifetime] *) 19 + 20 + val max_connection_uses : int option Cmdliner.Term.t 21 + (** Cmdliner term for maximum connection uses. 22 + Default: None (unlimited) 23 + Flag: [--max-connection-uses] *) 24 + 25 + val connect_timeout : float Cmdliner.Term.t 26 + (** Cmdliner term for connection timeout in seconds. 27 + Default: 10.0 28 + Flag: [--connect-timeout] *) 29 + 30 + val connect_retry_count : int Cmdliner.Term.t 31 + (** Cmdliner term for number of connection retry attempts. 32 + Default: 3 33 + Flag: [--connect-retry-count] *) 34 + 35 + val connect_retry_delay : float Cmdliner.Term.t 36 + (** Cmdliner term for initial retry delay in seconds. 37 + Default: 0.1 38 + Flag: [--connect-retry-delay] *) 39 + 40 + (** {1 Combined Terms} *) 41 + 42 + val config : Config.t Cmdliner.Term.t 43 + (** Cmdliner term that combines all configuration options into a {!Config.t}. 44 + This term can be used in your application's main command to accept 45 + all connection pool configuration options from the command line. *)
+80
lib/config.ml
··· 1 + (** Configuration for connection pools *) 2 + 3 + let src = Logs.Src.create "conpool.config" ~doc:"Connection pool configuration" 4 + module Log = (val Logs.src_log src : Logs.LOG) 5 + 6 + type t = { 7 + max_connections_per_endpoint : int; 8 + max_idle_time : float; 9 + max_connection_lifetime : float; 10 + max_connection_uses : int option; 11 + health_check : ([`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option; 12 + connect_timeout : float option; 13 + connect_retry_count : int; 14 + connect_retry_delay : float; 15 + on_connection_created : (Endpoint.t -> unit) option; 16 + on_connection_closed : (Endpoint.t -> unit) option; 17 + on_connection_reused : (Endpoint.t -> unit) option; 18 + } 19 + 20 + let make 21 + ?(max_connections_per_endpoint = 10) 22 + ?(max_idle_time = 60.0) 23 + ?(max_connection_lifetime = 300.0) 24 + ?max_connection_uses 25 + ?health_check 26 + ?(connect_timeout = 10.0) 27 + ?(connect_retry_count = 3) 28 + ?(connect_retry_delay = 0.1) 29 + ?on_connection_created 30 + ?on_connection_closed 31 + ?on_connection_reused 32 + () = 33 + Log.debug (fun m -> 34 + m "Creating config: max_connections=%d, max_idle=%.1fs, max_lifetime=%.1fs" 35 + max_connections_per_endpoint max_idle_time max_connection_lifetime); 36 + { 37 + max_connections_per_endpoint; 38 + max_idle_time; 39 + max_connection_lifetime; 40 + max_connection_uses; 41 + health_check; 42 + connect_timeout = Some connect_timeout; 43 + connect_retry_count; 44 + connect_retry_delay; 45 + on_connection_created; 46 + on_connection_closed; 47 + on_connection_reused; 48 + } 49 + 50 + let default = make () 51 + 52 + let max_connections_per_endpoint t = t.max_connections_per_endpoint 53 + let max_idle_time t = t.max_idle_time 54 + let max_connection_lifetime t = t.max_connection_lifetime 55 + let max_connection_uses t = t.max_connection_uses 56 + let health_check t = t.health_check 57 + let connect_timeout t = t.connect_timeout 58 + let connect_retry_count t = t.connect_retry_count 59 + let connect_retry_delay t = t.connect_retry_delay 60 + let on_connection_created t = t.on_connection_created 61 + let on_connection_closed t = t.on_connection_closed 62 + let on_connection_reused t = t.on_connection_reused 63 + 64 + let pp ppf t = 65 + Fmt.pf ppf 66 + "@[<v>Config:@,\ 67 + - max_connections_per_endpoint: %d@,\ 68 + - max_idle_time: %.1fs@,\ 69 + - max_connection_lifetime: %.1fs@,\ 70 + - max_connection_uses: %s@,\ 71 + - connect_timeout: %s@,\ 72 + - connect_retry_count: %d@,\ 73 + - connect_retry_delay: %.2fs@]" 74 + t.max_connections_per_endpoint 75 + t.max_idle_time 76 + t.max_connection_lifetime 77 + (match t.max_connection_uses with Some n -> string_of_int n | None -> "unlimited") 78 + (match t.connect_timeout with Some f -> Fmt.str "%.1fs" f | None -> "none") 79 + t.connect_retry_count 80 + t.connect_retry_delay
+98
lib/config.mli
··· 1 + (** Configuration for connection pools *) 2 + 3 + (** {1 Logging} *) 4 + 5 + val src : Logs.Src.t 6 + (** Logs source for configuration operations. Configure logging with: 7 + {[ 8 + Logs.Src.set_level Conpool.Config.src (Some Logs.Debug); 9 + ]} 10 + *) 11 + 12 + (** {1 Type} *) 13 + 14 + type t 15 + (** Pool configuration *) 16 + 17 + (** {1 Construction} *) 18 + 19 + val make : 20 + ?max_connections_per_endpoint:int -> 21 + ?max_idle_time:float -> 22 + ?max_connection_lifetime:float -> 23 + ?max_connection_uses:int -> 24 + ?health_check:([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) -> 25 + ?connect_timeout:float -> 26 + ?connect_retry_count:int -> 27 + ?connect_retry_delay:float -> 28 + ?on_connection_created:(Endpoint.t -> unit) -> 29 + ?on_connection_closed:(Endpoint.t -> unit) -> 30 + ?on_connection_reused:(Endpoint.t -> unit) -> 31 + unit -> t 32 + (** Create pool configuration with optional parameters. 33 + 34 + @param max_connections_per_endpoint Maximum concurrent connections per endpoint (default: 10) 35 + @param max_idle_time Maximum time a connection can sit idle in seconds (default: 60.0) 36 + @param max_connection_lifetime Maximum connection age in seconds (default: 300.0) 37 + @param max_connection_uses Maximum times a connection can be reused (default: unlimited) 38 + @param health_check Custom health check function (default: none) 39 + @param connect_timeout Connection timeout in seconds (default: 10.0) 40 + @param connect_retry_count Number of connection retry attempts (default: 3) 41 + @param connect_retry_delay Initial retry delay in seconds, with exponential backoff (default: 0.1) 42 + @param on_connection_created Hook called when a connection is created 43 + @param on_connection_closed Hook called when a connection is closed 44 + @param on_connection_reused Hook called when a connection is reused 45 + *) 46 + 47 + val default : t 48 + (** Sensible defaults for most use cases: 49 + - max_connections_per_endpoint: 10 50 + - max_idle_time: 60.0s 51 + - max_connection_lifetime: 300.0s 52 + - max_connection_uses: unlimited 53 + - health_check: none 54 + - connect_timeout: 10.0s 55 + - connect_retry_count: 3 56 + - connect_retry_delay: 0.1s 57 + - hooks: none 58 + *) 59 + 60 + (** {1 Accessors} *) 61 + 62 + val max_connections_per_endpoint : t -> int 63 + (** Get maximum connections per endpoint. *) 64 + 65 + val max_idle_time : t -> float 66 + (** Get maximum idle time in seconds. *) 67 + 68 + val max_connection_lifetime : t -> float 69 + (** Get maximum connection lifetime in seconds. *) 70 + 71 + val max_connection_uses : t -> int option 72 + (** Get maximum connection uses, if any. *) 73 + 74 + val health_check : t -> ([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option 75 + (** Get custom health check function, if any. *) 76 + 77 + val connect_timeout : t -> float option 78 + (** Get connection timeout in seconds, if any. *) 79 + 80 + val connect_retry_count : t -> int 81 + (** Get number of connection retry attempts. *) 82 + 83 + val connect_retry_delay : t -> float 84 + (** Get initial retry delay in seconds. *) 85 + 86 + val on_connection_created : t -> (Endpoint.t -> unit) option 87 + (** Get connection created hook, if any. *) 88 + 89 + val on_connection_closed : t -> (Endpoint.t -> unit) option 90 + (** Get connection closed hook, if any. *) 91 + 92 + val on_connection_reused : t -> (Endpoint.t -> unit) option 93 + (** Get connection reused hook, if any. *) 94 + 95 + (** {1 Pretty-printing} *) 96 + 97 + val pp : t Fmt.t 98 + (** Pretty-printer for configuration. *)
+24
lib/connection.ml
··· 1 + (** Internal connection representation - not exposed in public API *) 2 + 3 + let src = Logs.Src.create "conpool.connection" ~doc:"Connection pool internal connection management" 4 + module Log = (val Logs.src_log src : Logs.LOG) 5 + 6 + type t = { 7 + flow : [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t; 8 + created_at : float; 9 + mutable last_used : float; 10 + mutable use_count : int; 11 + endpoint : Endpoint.t; 12 + } 13 + 14 + let flow t = t.flow 15 + let endpoint t = t.endpoint 16 + let created_at t = t.created_at 17 + let last_used t = t.last_used 18 + let use_count t = t.use_count 19 + 20 + let pp ppf t = 21 + Fmt.pf ppf "Connection(endpoint=%a, age=%.2fs, uses=%d)" 22 + Endpoint.pp t.endpoint 23 + (Unix.gettimeofday () -. t.created_at) 24 + t.use_count
+104 -251
lib/conpool.ml
··· 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 - 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 6 + (* Re-export submodules *) 7 + module Endpoint = Endpoint 8 + module Tls_config = Tls_config 9 + module Config = Config 10 + module Stats = Stats 11 + module Cmd = Cmd 165 12 166 13 type endp_stats = { 167 14 mutable active : int; ··· 178 25 mutex : Eio.Mutex.t; 179 26 } 180 27 181 - type ('clock, 'net) t = { 28 + type ('clock, 'net) internal = { 182 29 sw : Eio.Switch.t; 183 30 net : 'net; 184 31 clock : 'clock; ··· 188 35 endpoints_mutex : Eio.Mutex.t; 189 36 } 190 37 38 + type t = T : ('clock Eio.Time.clock, 'net Eio.Net.t) internal -> t 39 + 191 40 module EndpointTbl = Hashtbl.Make(struct 192 41 type t = Endpoint.t 193 42 let equal = Endpoint.equal 194 43 let hash = Endpoint.hash 195 44 end) 196 45 197 - let get_time pool = 46 + let get_time (pool : ('clock, 'net) internal) = 198 47 Eio.Time.now pool.clock 199 48 200 49 let create_endp_stats () = { ··· 206 55 errors = 0; 207 56 } 208 57 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 - } 58 + let snapshot_stats (stats : endp_stats) : Stats.t = 59 + Stats.make 60 + ~active:stats.active 61 + ~idle:stats.idle 62 + ~total_created:stats.total_created 63 + ~total_reused:stats.total_reused 64 + ~total_closed:stats.total_closed 65 + ~errors:stats.errors 217 66 218 67 (** {1 DNS Resolution} *) 219 68 220 - let resolve_endpoint pool endpoint = 69 + let resolve_endpoint (pool : ('clock, 'net) internal) endpoint = 221 70 Log.debug (fun m -> m "Resolving %a..." Endpoint.pp endpoint); 222 71 let addrs = Eio.Net.getaddrinfo_stream pool.net (Endpoint.host endpoint) ~service:(string_of_int (Endpoint.port endpoint)) in 223 72 Log.debug (fun m -> m "Got address list for %a" Endpoint.pp endpoint); ··· 232 81 233 82 (** {1 Connection Creation with Retry} *) 234 83 235 - let rec create_connection_with_retry pool endpoint attempt = 236 - if attempt > pool.config.connect_retry_count then begin 84 + let rec create_connection_with_retry (pool : ('clock, 'net) internal) endpoint attempt = 85 + let retry_count = Config.connect_retry_count pool.config in 86 + if attempt > retry_count then begin 237 87 Log.err (fun m -> m "Failed to connect to %a after %d attempts" 238 - Endpoint.pp endpoint pool.config.connect_retry_count); 88 + Endpoint.pp endpoint retry_count); 239 89 failwith (Printf.sprintf "Failed to connect to %s:%d after %d attempts" 240 - (Endpoint.host endpoint) (Endpoint.port endpoint) pool.config.connect_retry_count) 90 + (Endpoint.host endpoint) (Endpoint.port endpoint) retry_count) 241 91 end; 242 92 243 93 Log.debug (fun m -> m "Connecting to %a (attempt %d/%d)" 244 - Endpoint.pp endpoint attempt pool.config.connect_retry_count); 94 + Endpoint.pp endpoint attempt retry_count); 245 95 246 96 try 247 97 let addr = resolve_endpoint pool endpoint in ··· 249 99 250 100 (* Connect with optional timeout *) 251 101 let socket = 252 - match pool.config.connect_timeout with 102 + match Config.connect_timeout pool.config with 253 103 | Some timeout -> 254 104 Eio.Time.with_timeout_exn pool.clock timeout 255 105 (fun () -> Eio.Net.connect ~sw:pool.sw pool.net addr) ··· 286 136 | Eio.Time.Timeout -> 287 137 Log.warn (fun m -> m "Connection timeout to %a (attempt %d)" Endpoint.pp endpoint attempt); 288 138 (* Exponential backoff *) 289 - let delay = pool.config.connect_retry_delay *. (2.0 ** float_of_int (attempt - 1)) in 139 + let delay = Config.connect_retry_delay pool.config *. (2.0 ** float_of_int (attempt - 1)) in 290 140 Eio.Time.sleep pool.clock delay; 291 141 create_connection_with_retry pool endpoint (attempt + 1) 292 142 | e -> 293 143 (* Other errors - retry with backoff *) 294 144 Log.warn (fun m -> m "Connection attempt %d to %a failed: %s" 295 145 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 146 + if attempt < Config.connect_retry_count pool.config then ( 147 + let delay = Config.connect_retry_delay pool.config *. (2.0 ** float_of_int (attempt - 1)) in 298 148 Eio.Time.sleep pool.clock delay; 299 149 create_connection_with_retry pool endpoint (attempt + 1) 300 150 ) else 301 151 raise e 302 152 303 - let create_connection pool endpoint = 153 + let create_connection (pool : ('clock, 'net) internal) endpoint = 304 154 create_connection_with_retry pool endpoint 1 305 155 306 156 (** {1 Connection Validation} *) 307 157 308 - let is_healthy pool ?(check_readable = false) conn = 158 + let is_healthy (pool : ('clock, 'net) internal) ?(check_readable = false) conn = 309 159 let now = get_time pool in 310 160 311 161 (* Check age *) 312 162 let age = now -. Connection.created_at conn in 313 - if age > pool.config.max_connection_lifetime then begin 163 + let max_lifetime = Config.max_connection_lifetime pool.config in 164 + if age > max_lifetime then begin 314 165 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); 166 + Endpoint.pp (Connection.endpoint conn) age max_lifetime); 316 167 false 317 168 end 318 169 319 170 (* 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 171 + else begin 172 + let max_idle = Config.max_idle_time pool.config in 173 + if (now -. Connection.last_used conn) > max_idle then begin 174 + let idle_time = now -. Connection.last_used conn in 175 + Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max idle time (%.2fs > %.2fs)" 176 + Endpoint.pp (Connection.endpoint conn) idle_time max_idle); 177 + false 178 + end 326 179 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 180 + (* Check use count *) 181 + else if (match Config.max_connection_uses pool.config with 182 + | Some max -> Connection.use_count conn >= max 183 + | None -> false) then begin 184 + Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max use count (%d)" 185 + Endpoint.pp (Connection.endpoint conn) (Connection.use_count conn)); 186 + false 187 + end 335 188 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 189 + (* Optional: custom health check *) 190 + else if (match Config.health_check pool.config with 191 + | Some check -> 192 + (try 193 + let healthy = check (Connection.flow conn) in 194 + if not healthy then 195 + Log.debug (fun m -> m "Connection to %a failed custom health check" 196 + Endpoint.pp (Connection.endpoint conn)); 197 + not healthy 198 + with e -> 199 + Log.debug (fun m -> m "Connection to %a health check raised exception: %s" 200 + Endpoint.pp (Connection.endpoint conn) (Printexc.to_string e)); 201 + true) (* Exception in health check = unhealthy *) 202 + | None -> false) then 203 + false 204 + 205 + (* Optional: check if socket still connected *) 206 + else if check_readable then 207 + try 208 + (* TODO avsm: a sockopt for this? *) 209 + true 210 + with 211 + | _ -> false 351 212 352 - (* Optional: check if socket still connected *) 353 - else if check_readable then 354 - try 355 - (* TODO avsm: a sockopt for this? *) 213 + else begin 214 + Log.debug (fun m -> m "Connection to %a is healthy (age=%.2fs, idle=%.2fs, uses=%d)" 215 + Endpoint.pp (Connection.endpoint conn) 216 + age 217 + (now -. Connection.last_used conn) 218 + (Connection.use_count conn)); 356 219 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 220 + end 367 221 end 368 222 369 223 (** {1 Internal Pool Operations} *) 370 224 371 - let close_internal pool conn = 225 + let close_internal (pool : ('clock, 'net) internal) conn = 372 226 Log.debug (fun m -> m "Closing connection to %a (age=%.2fs, uses=%d)" 373 227 Endpoint.pp (Connection.endpoint conn) 374 228 (get_time pool -. Connection.created_at conn) ··· 381 235 ); 382 236 383 237 (* Call hook if configured *) 384 - Option.iter (fun f -> f (Connection.endpoint conn)) pool.config.on_connection_closed 238 + Option.iter (fun f -> f (Connection.endpoint conn)) (Config.on_connection_closed pool.config) 385 239 386 - let get_or_create_endpoint_pool pool endpoint = 240 + let get_or_create_endpoint_pool (pool : ('clock, 'net) internal) endpoint = 387 241 Log.debug (fun m -> m "Getting or creating endpoint pool for %a" Endpoint.pp endpoint); 388 242 389 243 (* First try with read lock *) ··· 408 262 let mutex = Eio.Mutex.create () in 409 263 410 264 Log.info (fun m -> m "Creating new endpoint pool for %a (max_connections=%d)" 411 - Endpoint.pp endpoint pool.config.max_connections_per_endpoint); 265 + Endpoint.pp endpoint (Config.max_connections_per_endpoint pool.config)); 412 266 413 267 Log.debug (fun m -> m "About to create Eio.Pool for %a" Endpoint.pp endpoint); 414 268 415 269 let eio_pool = Eio.Pool.create 416 - pool.config.max_connections_per_endpoint 270 + (Config.max_connections_per_endpoint pool.config) 417 271 ~validate:(fun conn -> 418 272 Log.debug (fun m -> m "Validate called for connection to %a" Endpoint.pp endpoint); 419 273 (* Called before reusing from pool *) ··· 428 282 ); 429 283 430 284 (* Call hook if configured *) 431 - Option.iter (fun f -> f endpoint) pool.config.on_connection_reused; 285 + Option.iter (fun f -> f endpoint) (Config.on_connection_reused pool.config); 432 286 433 287 (* Run health check if configured *) 434 - match pool.config.health_check with 288 + match Config.health_check pool.config with 435 289 | Some check -> 436 290 (try check (Connection.flow conn) 437 291 with _ -> false) ··· 465 319 ); 466 320 467 321 (* Call hook if configured *) 468 - Option.iter (fun f -> f endpoint) pool.config.on_connection_created; 322 + Option.iter (fun f -> f endpoint) (Config.on_connection_created pool.config); 469 323 470 324 conn 471 325 with e -> ··· 494 348 495 349 (** {1 Public API - Pool Creation} *) 496 350 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 = 351 + let create ~sw ~(net : 'net Eio.Net.t) ~(clock : 'clock Eio.Time.clock) ?tls ?(config = Config.default) () : t = 498 352 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); 353 + (Config.max_connections_per_endpoint config) 354 + (Config.max_idle_time config) 355 + (Config.max_connection_lifetime config)); 502 356 503 357 let pool = { 504 358 sw; ··· 524 378 ) 525 379 ); 526 380 527 - pool 381 + T pool 528 382 529 383 (** {1 Public API - Connection Management} *) 530 384 531 - let with_connection (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint f = 385 + let with_connection (T pool) endpoint f = 532 386 Log.debug (fun m -> m "Acquiring connection to %a" Endpoint.pp endpoint); 533 387 let ep_pool = get_or_create_endpoint_pool pool endpoint in 534 388 ··· 587 441 588 442 (** {1 Public API - Statistics} *) 589 443 590 - let stats (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint = 444 + let stats (T pool) endpoint = 591 445 match Hashtbl.find_opt pool.endpoints endpoint with 592 446 | Some ep_pool -> 593 447 Eio.Mutex.use_ro ep_pool.mutex (fun () -> ··· 595 449 ) 596 450 | None -> 597 451 (* 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 - } 452 + Stats.make 453 + ~active:0 454 + ~idle:0 455 + ~total_created:0 456 + ~total_reused:0 457 + ~total_closed:0 458 + ~errors:0 606 459 607 - let all_stats (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) = 460 + let all_stats (T pool) = 608 461 Eio.Mutex.use_ro pool.endpoints_mutex (fun () -> 609 462 Hashtbl.fold (fun endpoint ep_pool acc -> 610 463 let stats = Eio.Mutex.use_ro ep_pool.mutex (fun () -> ··· 616 469 617 470 (** {1 Public API - Pool Management} *) 618 471 619 - let clear_endpoint (pool : ('clock Eio.Time.clock, 'net Eio.Net.t) t) endpoint = 472 + let clear_endpoint (T pool) endpoint = 620 473 Log.info (fun m -> m "Clearing endpoint %a from pool" Endpoint.pp endpoint); 621 474 match Hashtbl.find_opt pool.endpoints endpoint with 622 475 | Some _ep_pool ->
+23 -121
lib/conpool.mli
··· 3 3 (** {1 Logging} *) 4 4 5 5 val src : Logs.Src.t 6 - (** Logs source for conpool. Configure logging with: 6 + (** Logs source for the main connection pool. 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 + 12 + Each submodule also exposes its own log source for fine-grained control: 13 + - {!Endpoint.src} - endpoint operations 14 + - {!Tls_config.src} - TLS configuration 15 + - {!Config.src} - pool configuration 11 16 *) 12 17 13 18 (** {1 Core Types} *) 14 19 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 *) 20 + (** Network endpoint representation *) 21 + module Endpoint : module type of Endpoint 116 22 117 - val total_created : t -> int 118 - (** Total connections created (lifetime) *) 119 - 120 - val total_reused : t -> int 121 - (** Total times connections were reused *) 23 + (** TLS configuration for connection pools *) 24 + module Tls_config : module type of Tls_config 122 25 123 - val total_closed : t -> int 124 - (** Total connections closed *) 26 + (** Configuration for connection pools *) 27 + module Config : module type of Config 125 28 126 - val errors : t -> int 127 - (** Total connection errors *) 29 + (** Statistics for connection pool endpoints *) 30 + module Stats : module type of Stats 128 31 129 - val pp : Format.formatter -> t -> unit 130 - (** Pretty-print endpoint statistics *) 131 - end 32 + (** Cmdliner terms for connection pool configuration *) 33 + module Cmd : module type of Cmd 132 34 133 35 (** {1 Connection Pool} *) 134 36 135 - type ('clock, 'net) t 136 - (** Connection pool managing multiple endpoints, parameterized by clock and network types *) 37 + type t 38 + (** Connection pool managing multiple endpoints *) 137 39 138 40 val create : 139 41 sw:Eio.Switch.t -> ··· 141 43 clock:'clock Eio.Time.clock -> 142 44 ?tls:Tls_config.t -> 143 45 ?config:Config.t -> 144 - unit -> ('clock Eio.Time.clock, 'net Eio.Net.t) t 46 + unit -> t 145 47 (** Create connection pool bound to switch. 146 48 All connections will be closed when switch is released. 147 49 ··· 154 56 (** {1 Connection Usage} *) 155 57 156 58 val with_connection : 157 - ('clock Eio.Time.clock, 'net Eio.Net.t) t -> 59 + t -> 158 60 Endpoint.t -> 159 61 ([ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t -> 'a) -> 160 62 'a ··· 186 88 (** {1 Statistics & Monitoring} *) 187 89 188 90 val stats : 189 - ('clock Eio.Time.clock, 'net Eio.Net.t) t -> 91 + t -> 190 92 Endpoint.t -> 191 93 Stats.t 192 94 (** Get statistics for specific endpoint *) 193 95 194 96 val all_stats : 195 - ('clock Eio.Time.clock, 'net Eio.Net.t) t -> 97 + t -> 196 98 (Endpoint.t * Stats.t) list 197 99 (** Get statistics for all endpoints in pool *) 198 100 199 101 (** {1 Pool Management} *) 200 102 201 103 val clear_endpoint : 202 - ('clock Eio.Time.clock, 'net Eio.Net.t) t -> 104 + t -> 203 105 Endpoint.t -> 204 106 unit 205 107 (** Clear all cached connections for a specific endpoint.
+1 -1
lib/dune
··· 1 1 (library 2 2 (name conpool) 3 3 (public_name conpool) 4 - (libraries eio eio.unix tls-eio logs)) 4 + (libraries eio eio.unix tls-eio logs fmt cmdliner))
+24
lib/endpoint.ml
··· 1 + (** Network endpoint representation *) 2 + 3 + let src = Logs.Src.create "conpool.endpoint" ~doc:"Connection pool endpoint operations" 4 + module Log = (val Logs.src_log src : Logs.LOG) 5 + 6 + type t = { 7 + host : string; 8 + port : int; 9 + } 10 + 11 + let make ~host ~port = 12 + Log.debug (fun m -> m "Creating endpoint: %s:%d" host port); 13 + { host; port } 14 + 15 + let host t = t.host 16 + let port t = t.port 17 + 18 + let equal t1 t2 = 19 + String.equal t1.host t2.host && t1.port = t2.port 20 + 21 + let hash t = 22 + Hashtbl.hash (t.host, t.port) 23 + 24 + let pp = Fmt.of_to_string (fun t -> Printf.sprintf "%s:%d" t.host t.port)
+41
lib/endpoint.mli
··· 1 + (** Network endpoint representation *) 2 + 3 + (** {1 Logging} *) 4 + 5 + val src : Logs.Src.t 6 + (** Logs source for endpoint operations. Configure logging with: 7 + {[ 8 + Logs.Src.set_level Conpool.Endpoint.src (Some Logs.Debug); 9 + ]} 10 + *) 11 + 12 + (** {1 Type} *) 13 + 14 + type t 15 + (** Network endpoint identified by host and port *) 16 + 17 + (** {1 Construction} *) 18 + 19 + val make : host:string -> port:int -> t 20 + (** Create an endpoint from a hostname and port. *) 21 + 22 + (** {1 Accessors} *) 23 + 24 + val host : t -> string 25 + (** Get the hostname from an endpoint. *) 26 + 27 + val port : t -> int 28 + (** Get the port number from an endpoint. *) 29 + 30 + (** {1 Comparison and Hashing} *) 31 + 32 + val equal : t -> t -> bool 33 + (** Compare two endpoints for equality. *) 34 + 35 + val hash : t -> int 36 + (** Hash an endpoint for use in hash tables. *) 37 + 38 + (** {1 Pretty-printing} *) 39 + 40 + val pp : t Fmt.t 41 + (** Pretty-printer for endpoints. Formats as "host:port". *)
+36
lib/stats.ml
··· 1 + (** Statistics for connection pool endpoints *) 2 + 3 + type t = { 4 + active : int; 5 + idle : int; 6 + total_created : int; 7 + total_reused : int; 8 + total_closed : int; 9 + errors : int; 10 + } 11 + 12 + let make ~active ~idle ~total_created ~total_reused ~total_closed ~errors = 13 + { active; idle; total_created; total_reused; total_closed; errors } 14 + 15 + let active t = t.active 16 + let idle t = t.idle 17 + let total_created t = t.total_created 18 + let total_reused t = t.total_reused 19 + let total_closed t = t.total_closed 20 + let errors t = t.errors 21 + 22 + let pp ppf t = 23 + Fmt.pf ppf 24 + "@[<v>Stats:@,\ 25 + - Active: %d@,\ 26 + - Idle: %d@,\ 27 + - Created: %d@,\ 28 + - Reused: %d@,\ 29 + - Closed: %d@,\ 30 + - Errors: %d@]" 31 + t.active 32 + t.idle 33 + t.total_created 34 + t.total_reused 35 + t.total_closed 36 + t.errors
+43
lib/stats.mli
··· 1 + (** Statistics for connection pool endpoints *) 2 + 3 + (** {1 Type} *) 4 + 5 + type t 6 + (** Statistics snapshot for a specific endpoint *) 7 + 8 + (** {1 Construction} *) 9 + 10 + val make : 11 + active:int -> 12 + idle:int -> 13 + total_created:int -> 14 + total_reused:int -> 15 + total_closed:int -> 16 + errors:int -> 17 + t 18 + (** Create a statistics snapshot. *) 19 + 20 + (** {1 Accessors} *) 21 + 22 + val active : t -> int 23 + (** Number of connections currently in use. *) 24 + 25 + val idle : t -> int 26 + (** Number of connections in pool waiting to be reused. *) 27 + 28 + val total_created : t -> int 29 + (** Total connections created over the endpoint's lifetime. *) 30 + 31 + val total_reused : t -> int 32 + (** Total number of times connections were reused from the pool. *) 33 + 34 + val total_closed : t -> int 35 + (** Total connections that have been closed. *) 36 + 37 + val errors : t -> int 38 + (** Total connection errors encountered. *) 39 + 40 + (** {1 Pretty-printing} *) 41 + 42 + val pp : t Fmt.t 43 + (** Pretty-printer for statistics. *)
+22
lib/tls_config.ml
··· 1 + (** TLS configuration for connection pools *) 2 + 3 + let src = Logs.Src.create "conpool.tls" ~doc:"Connection pool TLS configuration" 4 + module Log = (val Logs.src_log src : Logs.LOG) 5 + 6 + type t = { 7 + config : Tls.Config.client; 8 + servername : string option; 9 + } 10 + 11 + let make ~config ?servername () = 12 + Log.debug (fun m -> 13 + m "Creating TLS config with servername: %s" 14 + (match servername with Some s -> s | None -> "<default>")); 15 + { config; servername } 16 + 17 + let config t = t.config 18 + let servername t = t.servername 19 + 20 + let pp ppf t = 21 + Fmt.pf ppf "TLS(servername=%s)" 22 + (match t.servername with Some s -> s | None -> "<default>")
+37
lib/tls_config.mli
··· 1 + (** TLS configuration for connection pools *) 2 + 3 + (** {1 Logging} *) 4 + 5 + val src : Logs.Src.t 6 + (** Logs source for TLS configuration operations. Configure logging with: 7 + {[ 8 + Logs.Src.set_level Conpool.Tls_config.src (Some Logs.Debug); 9 + ]} 10 + *) 11 + 12 + (** {1 Type} *) 13 + 14 + type t 15 + (** TLS configuration applied to all connections in a pool *) 16 + 17 + (** {1 Construction} *) 18 + 19 + val make : config:Tls.Config.client -> ?servername:string -> unit -> t 20 + (** Create TLS configuration. 21 + 22 + @param config TLS client configuration for all connections 23 + @param servername Optional SNI server name override. If [None], uses the endpoint's hostname 24 + *) 25 + 26 + (** {1 Accessors} *) 27 + 28 + val config : t -> Tls.Config.client 29 + (** Get the TLS client configuration. *) 30 + 31 + val servername : t -> string option 32 + (** Get the SNI server name override, if any. *) 33 + 34 + (** {1 Pretty-printing} *) 35 + 36 + val pp : t Fmt.t 37 + (** Pretty-printer for TLS configuration. *)