anil.recoil.org
TCP/TLS connection pooling for Eio
init
+767
-490
+17
-1
.gitignore
+17
-1
.gitignore
+1
.ocamlformat
+1
.ocamlformat
···
1
+
version=0.28.1
+53
.tangled/workflows/build.yml
+53
.tangled/workflows/build.yml
···
1
+
when:
2
+
- event: ["push", "pull_request"]
3
+
branch: ["main"]
4
+
5
+
engine: nixery
6
+
7
+
dependencies:
8
+
nixpkgs:
9
+
- shell
10
+
- stdenv
11
+
- findutils
12
+
- binutils
13
+
- libunwind
14
+
- ncurses
15
+
- opam
16
+
- git
17
+
- gawk
18
+
- gnupatch
19
+
- gnum4
20
+
- gnumake
21
+
- gnutar
22
+
- gnused
23
+
- gnugrep
24
+
- diffutils
25
+
- gzip
26
+
- bzip2
27
+
- gcc
28
+
- ocaml
29
+
- pkg-config
30
+
31
+
steps:
32
+
- name: opam
33
+
command: |
34
+
opam init --disable-sandboxing -a -y
35
+
- name: repo
36
+
command: |
37
+
opam repo add aoah https://tangled.org/anil.recoil.org/aoah-opam-repo.git
38
+
- name: switch
39
+
command: |
40
+
opam install . --confirm-level=unsafe-yes --deps-only
41
+
- name: build
42
+
command: |
43
+
opam exec -- dune build -p conpool
44
+
- name: switch-test
45
+
command: |
46
+
opam install . --confirm-level=unsafe-yes --deps-only --with-test
47
+
- name: test
48
+
command: |
49
+
opam exec -- dune runtest --verbose
50
+
- name: doc
51
+
command: |
52
+
opam install -y odoc
53
+
opam exec -- dune build @doc
+15
LICENSE.md
+15
LICENSE.md
···
1
+
ISC License
2
+
3
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>
4
+
5
+
Permission to use, copy, modify, and distribute this software for any
6
+
purpose with or without fee is hereby granted, provided that the above
7
+
copyright notice and this permission notice appear in all copies.
8
+
9
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+113
README.md
+113
README.md
···
1
+
# Conpool - Protocol-agnostic Connection Pooling for Eio
2
+
3
+
Conpool is a connection pooling library built on Eio that manages TCP connection lifecycles, validates connection health, and provides per-endpoint resource limiting for any TCP-based protocol.
4
+
5
+
## Key Features
6
+
7
+
- **Protocol-agnostic**: Works with HTTP, Redis, PostgreSQL, or any TCP-based protocol
8
+
- **Health validation**: Automatically validates connections before reuse
9
+
- **Per-endpoint limits**: Independent connection limits and pooling for each endpoint
10
+
- **TLS support**: Optional TLS configuration for secure connections
11
+
- **Statistics & monitoring**: Track connection usage, hits/misses, and health status
12
+
- **Built on Eio**: Leverages Eio's structured concurrency and resource management
13
+
14
+
## Usage
15
+
16
+
Basic example establishing a connection pool:
17
+
18
+
```ocaml
19
+
open Eio.Std
20
+
21
+
let run env =
22
+
Switch.run (fun sw ->
23
+
(* Create a connection pool *)
24
+
let pool = Conpool.create
25
+
~sw
26
+
~net:(Eio.Stdenv.net env)
27
+
~clock:(Eio.Stdenv.clock env)
28
+
()
29
+
in
30
+
31
+
(* Define an endpoint *)
32
+
let endpoint = Conpool.Endpoint.make ~host:"example.com" ~port:80 in
33
+
34
+
(* Use a connection from the pool *)
35
+
Conpool.with_connection pool endpoint (fun conn ->
36
+
Eio.Flow.copy_string "GET / HTTP/1.1\r\nHost: example.com\r\n\r\n" conn;
37
+
let buf = Eio.Buf_read.of_flow conn ~max_size:4096 in
38
+
Eio.Buf_read.take_all buf
39
+
)
40
+
)
41
+
```
42
+
43
+
With TLS configuration:
44
+
45
+
```ocaml
46
+
let run env =
47
+
Switch.run (fun sw ->
48
+
(* Create TLS configuration *)
49
+
let tls = Conpool.Tls_config.make
50
+
~authenticator:(Ca_certs.authenticator ())
51
+
()
52
+
in
53
+
54
+
(* Create pool with TLS *)
55
+
let pool = Conpool.create
56
+
~sw
57
+
~net:(Eio.Stdenv.net env)
58
+
~clock:(Eio.Stdenv.clock env)
59
+
~tls
60
+
()
61
+
in
62
+
63
+
let endpoint = Conpool.Endpoint.make ~host:"example.com" ~port:443 in
64
+
Conpool.with_connection pool endpoint (fun conn ->
65
+
(* Use TLS-encrypted connection *)
66
+
...
67
+
)
68
+
)
69
+
```
70
+
71
+
Custom pool configuration:
72
+
73
+
```ocaml
74
+
let config = Conpool.Config.make
75
+
~max_connections_per_endpoint:20
76
+
~max_idle_per_endpoint:5
77
+
~connection_timeout:10.0
78
+
~validation_interval:300.0
79
+
()
80
+
in
81
+
82
+
let pool = Conpool.create ~sw ~net ~clock ~config ()
83
+
```
84
+
85
+
Monitor pool statistics:
86
+
87
+
```ocaml
88
+
let stats = Conpool.stats pool endpoint in
89
+
Printf.printf "Active: %d, Idle: %d, Hits: %d, Misses: %d\n"
90
+
(Conpool.Stats.active_connections stats)
91
+
(Conpool.Stats.idle_connections stats)
92
+
(Conpool.Stats.cache_hits stats)
93
+
(Conpool.Stats.cache_misses stats)
94
+
```
95
+
96
+
## Installation
97
+
98
+
```
99
+
opam install conpool
100
+
```
101
+
102
+
## Documentation
103
+
104
+
API documentation is available at https://tangled.org/@anil.recoil.org/ocaml-conpool or via:
105
+
106
+
```
107
+
opam install conpool
108
+
odig doc conpool
109
+
```
110
+
111
+
## License
112
+
113
+
ISC
+8
-8
conpool.opam
+8
-8
conpool.opam
···
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
-
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"
6
+
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
7
+
authors: ["Anil Madhavapeddy <anil@recoil.org>"]
8
+
license: "ISC"
9
+
homepage: "https://tangled.org/@anil.recoil.org/ocaml-conpool"
10
+
bug-reports: "https://tangled.org/@anil.recoil.org/ocaml-conpool/issues"
11
11
depends: [
12
-
"ocaml"
13
-
"dune" {>= "3.0" & >= "3.0"}
12
+
"ocaml" {>= "5.1.0"}
13
+
"dune" {>= "3.20" & >= "3.0"}
14
14
"eio"
15
15
"tls-eio" {>= "1.0"}
16
16
"logs"
···
32
32
"@doc" {with-doc}
33
33
]
34
34
]
35
-
dev-repo: "git+https://github.com/username/conpool.git"
35
+
x-maintenance-intent: ["(latest)"]
+11
-11
dune-project
+11
-11
dune-project
···
1
-
(lang dune 3.0)
1
+
(lang dune 3.20)
2
+
2
3
(name conpool)
3
4
4
5
(generate_opam_files true)
5
6
6
-
(source
7
-
(github username/conpool))
8
-
9
-
(authors "Your Name")
10
-
11
-
(maintainers "Your Name")
12
-
13
-
(license MIT)
7
+
(license ISC)
8
+
(authors "Anil Madhavapeddy <anil@recoil.org>")
9
+
(homepage "https://tangled.org/@anil.recoil.org/ocaml-conpool")
10
+
(maintainers "Anil Madhavapeddy <anil@recoil.org>")
11
+
(bug_reports "https://tangled.org/@anil.recoil.org/ocaml-conpool/issues")
12
+
(maintenance_intent "(latest)")
14
13
15
14
(package
16
15
(name conpool)
17
16
(synopsis "Protocol-agnostic TCP/IP connection pooling library for Eio")
18
17
(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
18
(depends
20
-
ocaml
19
+
(ocaml (>= 5.1.0))
21
20
(dune (>= 3.0))
22
21
eio
23
22
(tls-eio (>= 1.0))
24
23
logs
25
24
fmt
26
-
cmdliner))
25
+
cmdliner
26
+
(odoc :with-doc)))
+30
-25
lib/cmd.ml
+30
-25
lib/cmd.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Cmdliner terms for connection pool configuration *)
2
7
3
8
open Cmdliner
4
9
5
10
let max_connections_per_endpoint =
6
11
let doc = "Maximum concurrent connections per endpoint." in
7
-
Arg.(value & opt int 10 & info ["max-connections-per-endpoint"] ~doc ~docv:"NUM")
12
+
Arg.(
13
+
value & opt int 10
14
+
& info [ "max-connections-per-endpoint" ] ~doc ~docv:"NUM")
8
15
9
16
let max_idle_time =
10
17
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")
18
+
Arg.(value & opt float 60.0 & info [ "max-idle-time" ] ~doc ~docv:"SECONDS")
12
19
13
20
let max_connection_lifetime =
14
21
let doc = "Maximum connection age in seconds." in
15
-
Arg.(value & opt float 300.0 & info ["max-connection-lifetime"] ~doc ~docv:"SECONDS")
22
+
Arg.(
23
+
value & opt float 300.0
24
+
& info [ "max-connection-lifetime" ] ~doc ~docv:"SECONDS")
16
25
17
26
let max_connection_uses =
18
27
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")
28
+
Arg.(
29
+
value
30
+
& opt (some int) None
31
+
& info [ "max-connection-uses" ] ~doc ~docv:"NUM")
20
32
21
33
let connect_timeout =
22
34
let doc = "Connection timeout in seconds." in
23
-
Arg.(value & opt float 10.0 & info ["connect-timeout"] ~doc ~docv:"SECONDS")
35
+
Arg.(value & opt float 10.0 & info [ "connect-timeout" ] ~doc ~docv:"SECONDS")
24
36
25
37
let connect_retry_count =
26
38
let doc = "Number of connection retry attempts." in
27
-
Arg.(value & opt int 3 & info ["connect-retry-count"] ~doc ~docv:"NUM")
39
+
Arg.(value & opt int 3 & info [ "connect-retry-count" ] ~doc ~docv:"NUM")
28
40
29
41
let connect_retry_delay =
30
42
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")
43
+
Arg.(
44
+
value & opt float 0.1 & info [ "connect-retry-delay" ] ~doc ~docv:"SECONDS")
32
45
33
46
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
-
()
47
+
let make max_conn max_idle max_lifetime max_uses timeout retry_count
48
+
retry_delay =
49
+
Config.make ~max_connections_per_endpoint:max_conn ~max_idle_time:max_idle
50
+
~max_connection_lifetime:max_lifetime ?max_connection_uses:max_uses
51
+
~connect_timeout:timeout ~connect_retry_count:retry_count
52
+
~connect_retry_delay:retry_delay ()
44
53
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)
54
+
Term.(
55
+
const make $ max_connections_per_endpoint $ max_idle_time
56
+
$ max_connection_lifetime $ max_connection_uses $ connect_timeout
57
+
$ connect_retry_count $ connect_retry_delay)
+20
-22
lib/cmd.mli
+20
-22
lib/cmd.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Cmdliner terms for connection pool configuration *)
2
7
3
8
(** {1 Configuration Terms} *)
4
9
5
10
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] *)
11
+
(** Cmdliner term for maximum connections per endpoint. Default: 10 Flag:
12
+
[--max-connections-per-endpoint] *)
9
13
10
14
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] *)
15
+
(** Cmdliner term for maximum idle time in seconds. Default: 60.0 Flag:
16
+
[--max-idle-time] *)
14
17
15
18
val max_connection_lifetime : float Cmdliner.Term.t
16
-
(** Cmdliner term for maximum connection lifetime in seconds.
17
-
Default: 300.0
19
+
(** Cmdliner term for maximum connection lifetime in seconds. Default: 300.0
18
20
Flag: [--max-connection-lifetime] *)
19
21
20
22
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] *)
23
+
(** Cmdliner term for maximum connection uses. Default: None (unlimited) Flag:
24
+
[--max-connection-uses] *)
24
25
25
26
val connect_timeout : float Cmdliner.Term.t
26
-
(** Cmdliner term for connection timeout in seconds.
27
-
Default: 10.0
28
-
Flag: [--connect-timeout] *)
27
+
(** Cmdliner term for connection timeout in seconds. Default: 10.0 Flag:
28
+
[--connect-timeout] *)
29
29
30
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] *)
31
+
(** Cmdliner term for number of connection retry attempts. Default: 3 Flag:
32
+
[--connect-retry-count] *)
34
33
35
34
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] *)
35
+
(** Cmdliner term for initial retry delay in seconds. Default: 0.1 Flag:
36
+
[--connect-retry-delay] *)
39
37
40
38
(** {1 Combined Terms} *)
41
39
42
40
val config : Config.t Cmdliner.Term.t
43
41
(** 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. *)
42
+
This term can be used in your application's main command to accept all
43
+
connection pool configuration options from the command line. *)
+46
-37
lib/config.ml
+46
-37
lib/config.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Configuration for connection pools *)
2
7
3
8
let src = Logs.Src.create "conpool.config" ~doc:"Connection pool configuration"
9
+
4
10
module Log = (val Logs.src_log src : Logs.LOG)
5
11
6
12
type t = {
···
8
14
max_idle_time : float;
9
15
max_connection_lifetime : float;
10
16
max_connection_uses : int option;
11
-
health_check : ([`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option;
17
+
health_check :
18
+
([ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t -> bool) option;
12
19
connect_timeout : float option;
13
20
connect_retry_count : int;
14
21
connect_retry_delay : float;
···
17
24
on_connection_reused : (Endpoint.t -> unit) option;
18
25
}
19
26
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
-
() =
27
+
let make ?(max_connections_per_endpoint = 10) ?(max_idle_time = 60.0)
28
+
?(max_connection_lifetime = 300.0) ?max_connection_uses ?health_check
29
+
?(connect_timeout = 10.0) ?(connect_retry_count = 3)
30
+
?(connect_retry_delay = 0.1) ?on_connection_created ?on_connection_closed
31
+
?on_connection_reused () =
33
32
(* Validate parameters *)
34
33
if max_connections_per_endpoint <= 0 then
35
-
invalid_arg (Printf.sprintf "max_connections_per_endpoint must be positive, got %d"
36
-
max_connections_per_endpoint);
34
+
invalid_arg
35
+
(Printf.sprintf "max_connections_per_endpoint must be positive, got %d"
36
+
max_connections_per_endpoint);
37
37
38
38
if max_idle_time <= 0.0 then
39
-
invalid_arg (Printf.sprintf "max_idle_time must be positive, got %.2f" max_idle_time);
39
+
invalid_arg
40
+
(Printf.sprintf "max_idle_time must be positive, got %.2f" max_idle_time);
40
41
41
42
if max_connection_lifetime <= 0.0 then
42
-
invalid_arg (Printf.sprintf "max_connection_lifetime must be positive, got %.2f"
43
-
max_connection_lifetime);
43
+
invalid_arg
44
+
(Printf.sprintf "max_connection_lifetime must be positive, got %.2f"
45
+
max_connection_lifetime);
44
46
45
47
(match max_connection_uses with
46
-
| Some n when n <= 0 ->
47
-
invalid_arg (Printf.sprintf "max_connection_uses must be positive, got %d" n)
48
-
| _ -> ());
48
+
| Some n when n <= 0 ->
49
+
invalid_arg
50
+
(Printf.sprintf "max_connection_uses must be positive, got %d" n)
51
+
| _ -> ());
49
52
50
53
if connect_timeout <= 0.0 then
51
-
invalid_arg (Printf.sprintf "connect_timeout must be positive, got %.2f" connect_timeout);
54
+
invalid_arg
55
+
(Printf.sprintf "connect_timeout must be positive, got %.2f"
56
+
connect_timeout);
52
57
53
58
if connect_retry_count < 0 then
54
-
invalid_arg (Printf.sprintf "connect_retry_count must be non-negative, got %d"
55
-
connect_retry_count);
59
+
invalid_arg
60
+
(Printf.sprintf "connect_retry_count must be non-negative, got %d"
61
+
connect_retry_count);
56
62
57
63
if connect_retry_delay <= 0.0 then
58
-
invalid_arg (Printf.sprintf "connect_retry_delay must be positive, got %.2f"
59
-
connect_retry_delay);
64
+
invalid_arg
65
+
(Printf.sprintf "connect_retry_delay must be positive, got %.2f"
66
+
connect_retry_delay);
60
67
61
68
Log.debug (fun m ->
62
-
m "Creating config: max_connections=%d, max_idle=%.1fs, max_lifetime=%.1fs"
63
-
max_connections_per_endpoint max_idle_time max_connection_lifetime);
69
+
m
70
+
"Creating config: max_connections=%d, max_idle=%.1fs, \
71
+
max_lifetime=%.1fs"
72
+
max_connections_per_endpoint max_idle_time max_connection_lifetime);
64
73
{
65
74
max_connections_per_endpoint;
66
75
max_idle_time;
···
76
85
}
77
86
78
87
let default = make ()
79
-
80
88
let max_connections_per_endpoint t = t.max_connections_per_endpoint
81
89
let max_idle_time t = t.max_idle_time
82
90
let max_connection_lifetime t = t.max_connection_lifetime
···
99
107
- connect_timeout: %s@,\
100
108
- connect_retry_count: %d@,\
101
109
- connect_retry_delay: %.2fs@]"
102
-
t.max_connections_per_endpoint
103
-
t.max_idle_time
104
-
t.max_connection_lifetime
105
-
(match t.max_connection_uses with Some n -> string_of_int n | None -> "unlimited")
106
-
(match t.connect_timeout with Some f -> Fmt.str "%.1fs" f | None -> "none")
107
-
t.connect_retry_count
108
-
t.connect_retry_delay
110
+
t.max_connections_per_endpoint t.max_idle_time t.max_connection_lifetime
111
+
(match t.max_connection_uses with
112
+
| Some n -> string_of_int n
113
+
| None -> "unlimited")
114
+
(match t.connect_timeout with
115
+
| Some f -> Fmt.str "%.1fs" f
116
+
| None -> "none")
117
+
t.connect_retry_count t.connect_retry_delay
+25
-15
lib/config.mli
+25
-15
lib/config.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Configuration for connection pools *)
2
7
3
8
(** {1 Logging} *)
···
5
10
val src : Logs.Src.t
6
11
(** Logs source for configuration operations. Configure logging with:
7
12
{[
8
-
Logs.Src.set_level Conpool.Config.src (Some Logs.Debug);
9
-
]}
10
-
*)
13
+
Logs.Src.set_level Conpool.Config.src (Some Logs.Debug)
14
+
]} *)
11
15
12
16
(** {1 Type} *)
13
17
···
21
25
?max_idle_time:float ->
22
26
?max_connection_lifetime:float ->
23
27
?max_connection_uses:int ->
24
-
?health_check:([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) ->
28
+
?health_check:
29
+
([ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t -> bool) ->
25
30
?connect_timeout:float ->
26
31
?connect_retry_count:int ->
27
32
?connect_retry_delay:float ->
28
33
?on_connection_created:(Endpoint.t -> unit) ->
29
34
?on_connection_closed:(Endpoint.t -> unit) ->
30
35
?on_connection_reused:(Endpoint.t -> unit) ->
31
-
unit -> t
36
+
unit ->
37
+
t
32
38
(** Create pool configuration with optional parameters.
33
39
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)
40
+
@param max_connections_per_endpoint
41
+
Maximum concurrent connections per endpoint (default: 10)
42
+
@param max_idle_time
43
+
Maximum time a connection can sit idle in seconds (default: 60.0)
44
+
@param max_connection_lifetime
45
+
Maximum connection age in seconds (default: 300.0)
46
+
@param max_connection_uses
47
+
Maximum times a connection can be reused (default: unlimited)
38
48
@param health_check Custom health check function (default: none)
39
49
@param connect_timeout Connection timeout in seconds (default: 10.0)
40
50
@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)
51
+
@param connect_retry_delay
52
+
Initial retry delay in seconds, with exponential backoff (default: 0.1)
42
53
@param on_connection_created Hook called when a connection is created
43
54
@param on_connection_closed Hook called when a connection is closed
44
-
@param on_connection_reused Hook called when a connection is reused
45
-
*)
55
+
@param on_connection_reused Hook called when a connection is reused *)
46
56
47
57
val default : t
48
58
(** Sensible defaults for most use cases:
···
54
64
- connect_timeout: 10.0s
55
65
- connect_retry_count: 3
56
66
- connect_retry_delay: 0.1s
57
-
- hooks: none
58
-
*)
67
+
- hooks: none *)
59
68
60
69
(** {1 Accessors} *)
61
70
···
71
80
val max_connection_uses : t -> int option
72
81
(** Get maximum connection uses, if any. *)
73
82
74
-
val health_check : t -> ([ `Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t -> bool) option
83
+
val health_check :
84
+
t -> ([ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t -> bool) option
75
85
(** Get custom health check function, if any. *)
76
86
77
87
val connect_timeout : t -> float option
+16
-13
lib/connection.ml
+16
-13
lib/connection.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Internal connection representation - not exposed in public API *)
2
7
3
-
let src = Logs.Src.create "conpool.connection" ~doc:"Connection pool internal connection management"
8
+
let src =
9
+
Logs.Src.create "conpool.connection"
10
+
~doc:"Connection pool internal connection management"
11
+
4
12
module Log = (val Logs.src_log src : Logs.LOG)
5
13
6
14
type t = {
7
-
flow : [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t;
15
+
flow : [ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t;
8
16
created_at : float;
9
17
mutable last_used : float;
10
18
mutable use_count : int;
···
15
23
let flow t = t.flow
16
24
let endpoint t = t.endpoint
17
25
let created_at t = t.created_at
18
-
19
-
let last_used t =
20
-
Eio.Mutex.use_ro t.mutex (fun () -> t.last_used)
21
-
22
-
let use_count t =
23
-
Eio.Mutex.use_ro t.mutex (fun () -> t.use_count)
26
+
let last_used t = Eio.Mutex.use_ro t.mutex (fun () -> t.last_used)
27
+
let use_count t = Eio.Mutex.use_ro t.mutex (fun () -> t.use_count)
24
28
25
29
let update_usage t ~now =
26
30
Eio.Mutex.use_rw ~protect:true t.mutex (fun () ->
27
-
t.last_used <- now;
28
-
t.use_count <- t.use_count + 1
29
-
)
31
+
t.last_used <- now;
32
+
t.use_count <- t.use_count + 1)
30
33
31
34
let pp ppf t =
32
35
let uses = Eio.Mutex.use_ro t.mutex (fun () -> t.use_count) in
33
-
Fmt.pf ppf "Connection(endpoint=%a, age=%.2fs, uses=%d)"
34
-
Endpoint.pp t.endpoint
36
+
Fmt.pf ppf "Connection(endpoint=%a, age=%.2fs, uses=%d)" Endpoint.pp
37
+
t.endpoint
35
38
(Unix.gettimeofday () -. t.created_at)
36
39
uses
+318
-275
lib/conpool.ml
+318
-275
lib/conpool.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Conpool - Protocol-agnostic TCP/IP connection pooling library for Eio *)
2
7
3
8
let src = Logs.Src.create "conpool" ~doc:"Connection pooling library"
9
+
4
10
module Log = (val Logs.src_log src : Logs.LOG)
5
11
6
12
(* Re-export submodules *)
···
14
20
15
21
type error =
16
22
| Dns_resolution_failed of { hostname : string }
17
-
| Connection_failed of { endpoint : Endpoint.t; attempts : int; last_error : string }
23
+
| Connection_failed of {
24
+
endpoint : Endpoint.t;
25
+
attempts : int;
26
+
last_error : string;
27
+
}
18
28
| Connection_timeout of { endpoint : Endpoint.t; timeout : float }
19
29
| Invalid_config of string
20
30
| Invalid_endpoint of string
···
25
35
| Dns_resolution_failed { hostname } ->
26
36
Fmt.pf ppf "DNS resolution failed for hostname: %s" hostname
27
37
| Connection_failed { endpoint; attempts; last_error } ->
28
-
Fmt.pf ppf "Failed to connect to %a after %d attempts: %s"
29
-
Endpoint.pp endpoint attempts last_error
38
+
Fmt.pf ppf "Failed to connect to %a after %d attempts: %s" Endpoint.pp
39
+
endpoint attempts last_error
30
40
| Connection_timeout { endpoint; timeout } ->
31
-
Fmt.pf ppf "Connection timeout to %a after %.2fs"
32
-
Endpoint.pp endpoint timeout
33
-
| Invalid_config msg ->
34
-
Fmt.pf ppf "Invalid configuration: %s" msg
35
-
| Invalid_endpoint msg ->
36
-
Fmt.pf ppf "Invalid endpoint: %s" msg
41
+
Fmt.pf ppf "Connection timeout to %a after %.2fs" Endpoint.pp endpoint
42
+
timeout
43
+
| Invalid_config msg -> Fmt.pf ppf "Invalid configuration: %s" msg
44
+
| Invalid_endpoint msg -> Fmt.pf ppf "Invalid endpoint: %s" msg
37
45
38
46
type endp_stats = {
39
47
mutable active : int;
···
62
70
63
71
type t = T : ('clock Eio.Time.clock, 'net Eio.Net.t) internal -> t
64
72
65
-
module EndpointTbl = Hashtbl.Make(struct
73
+
module EndpointTbl = Hashtbl.Make (struct
66
74
type t = Endpoint.t
75
+
67
76
let equal = Endpoint.equal
68
77
let hash = Endpoint.hash
69
78
end)
70
79
71
-
let get_time (pool : ('clock, 'net) internal) =
72
-
Eio.Time.now pool.clock
80
+
let get_time (pool : ('clock, 'net) internal) = Eio.Time.now pool.clock
73
81
74
-
let create_endp_stats () = {
75
-
active = 0;
76
-
idle = 0;
77
-
total_created = 0;
78
-
total_reused = 0;
79
-
total_closed = 0;
80
-
errors = 0;
81
-
}
82
+
let create_endp_stats () =
83
+
{
84
+
active = 0;
85
+
idle = 0;
86
+
total_created = 0;
87
+
total_reused = 0;
88
+
total_closed = 0;
89
+
errors = 0;
90
+
}
82
91
83
92
let snapshot_stats (stats : endp_stats) : Stats.t =
84
-
Stats.make
85
-
~active:stats.active
86
-
~idle:stats.idle
87
-
~total_created:stats.total_created
88
-
~total_reused:stats.total_reused
89
-
~total_closed:stats.total_closed
90
-
~errors:stats.errors
93
+
Stats.make ~active:stats.active ~idle:stats.idle
94
+
~total_created:stats.total_created ~total_reused:stats.total_reused
95
+
~total_closed:stats.total_closed ~errors:stats.errors
91
96
92
97
(** {1 DNS Resolution} *)
93
98
94
99
let resolve_endpoint (pool : ('clock, 'net) internal) endpoint =
95
100
Log.debug (fun m -> m "Resolving %a..." Endpoint.pp endpoint);
96
-
let addrs = Eio.Net.getaddrinfo_stream pool.net (Endpoint.host endpoint) ~service:(string_of_int (Endpoint.port endpoint)) in
101
+
let addrs =
102
+
Eio.Net.getaddrinfo_stream pool.net (Endpoint.host endpoint)
103
+
~service:(string_of_int (Endpoint.port endpoint))
104
+
in
97
105
Log.debug (fun m -> m "Got address list for %a" Endpoint.pp endpoint);
98
106
match addrs with
99
107
| addr :: _ ->
100
-
Log.debug (fun m -> m "Resolved %a to %a"
101
-
Endpoint.pp endpoint Eio.Net.Sockaddr.pp addr);
108
+
Log.debug (fun m ->
109
+
m "Resolved %a to %a" Endpoint.pp endpoint Eio.Net.Sockaddr.pp addr);
102
110
addr
103
111
| [] ->
104
-
Log.err (fun m -> m "Failed to resolve hostname: %s" (Endpoint.host endpoint));
105
-
raise (Pool_error (Dns_resolution_failed { hostname = Endpoint.host endpoint }))
112
+
Log.err (fun m ->
113
+
m "Failed to resolve hostname: %s" (Endpoint.host endpoint));
114
+
raise
115
+
(Pool_error
116
+
(Dns_resolution_failed { hostname = Endpoint.host endpoint }))
106
117
107
118
(** {1 Connection Creation with Retry} *)
108
119
109
-
let rec create_connection_with_retry (pool : ('clock, 'net) internal) endpoint attempt last_error =
120
+
let rec create_connection_with_retry (pool : ('clock, 'net) internal) endpoint
121
+
attempt last_error =
110
122
let retry_count = Config.connect_retry_count pool.config in
111
123
if attempt > retry_count then begin
112
-
Log.err (fun m -> m "Failed to connect to %a after %d attempts"
113
-
Endpoint.pp endpoint retry_count);
114
-
raise (Pool_error (Connection_failed { endpoint; attempts = retry_count; last_error }))
124
+
Log.err (fun m ->
125
+
m "Failed to connect to %a after %d attempts" Endpoint.pp endpoint
126
+
retry_count);
127
+
raise
128
+
(Pool_error
129
+
(Connection_failed { endpoint; attempts = retry_count; last_error }))
115
130
end;
116
131
117
-
Log.debug (fun m -> m "Connecting to %a (attempt %d/%d)"
118
-
Endpoint.pp endpoint attempt retry_count);
132
+
Log.debug (fun m ->
133
+
m "Connecting to %a (attempt %d/%d)" Endpoint.pp endpoint attempt
134
+
retry_count);
119
135
120
136
try
121
137
let addr = resolve_endpoint pool endpoint in
···
125
141
let socket =
126
142
match Config.connect_timeout pool.config with
127
143
| Some timeout ->
128
-
Eio.Time.with_timeout_exn pool.clock timeout
129
-
(fun () -> Eio.Net.connect ~sw:pool.sw pool.net addr)
130
-
| None ->
131
-
Eio.Net.connect ~sw:pool.sw pool.net addr
144
+
Eio.Time.with_timeout_exn pool.clock timeout (fun () ->
145
+
Eio.Net.connect ~sw:pool.sw pool.net addr)
146
+
| None -> Eio.Net.connect ~sw:pool.sw pool.net addr
132
147
in
133
148
134
-
Log.debug (fun m -> m "TCP connection established to %a" Endpoint.pp endpoint);
149
+
Log.debug (fun m ->
150
+
m "TCP connection established to %a" Endpoint.pp endpoint);
135
151
136
-
let flow = match pool.tls with
137
-
| None -> (socket :> [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t)
152
+
let flow =
153
+
match pool.tls with
154
+
| None ->
155
+
(socket :> [ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t)
138
156
| Some tls_cfg ->
139
-
Log.debug (fun m -> m "Initiating TLS handshake with %a" Endpoint.pp endpoint);
140
-
let host = match Tls_config.servername tls_cfg with
157
+
Log.debug (fun m ->
158
+
m "Initiating TLS handshake with %a" Endpoint.pp endpoint);
159
+
let host =
160
+
match Tls_config.servername tls_cfg with
141
161
| Some name -> Domain_name.(host_exn (of_string_exn name))
142
-
| None -> Domain_name.(host_exn (of_string_exn (Endpoint.host endpoint)))
162
+
| None ->
163
+
Domain_name.(host_exn (of_string_exn (Endpoint.host endpoint)))
143
164
in
144
-
let tls_flow = Tls_eio.client_of_flow ~host (Tls_config.config tls_cfg) socket in
145
-
Log.info (fun m -> m "TLS connection established to %a" Endpoint.pp endpoint);
146
-
(tls_flow :> [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t)
165
+
let tls_flow =
166
+
Tls_eio.client_of_flow ~host (Tls_config.config tls_cfg) socket
167
+
in
168
+
Log.info (fun m ->
169
+
m "TLS connection established to %a" Endpoint.pp endpoint);
170
+
(tls_flow :> [ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t)
147
171
in
148
172
149
173
let now = get_time pool in
···
156
180
endpoint;
157
181
mutex = Eio.Mutex.create ();
158
182
}
159
-
160
183
with
161
184
| Eio.Time.Timeout as e ->
162
-
Log.warn (fun m -> m "Connection timeout to %a (attempt %d)" Endpoint.pp endpoint attempt);
185
+
Log.warn (fun m ->
186
+
m "Connection timeout to %a (attempt %d)" Endpoint.pp endpoint attempt);
163
187
let error_msg = Printexc.to_string e in
164
188
if attempt >= Config.connect_retry_count pool.config then
165
189
(* Last attempt - convert to our error type *)
···
167
191
| Some timeout ->
168
192
raise (Pool_error (Connection_timeout { endpoint; timeout }))
169
193
| None ->
170
-
raise (Pool_error (Connection_failed { endpoint; attempts = attempt; last_error = error_msg }))
194
+
raise
195
+
(Pool_error
196
+
(Connection_failed
197
+
{ endpoint; attempts = attempt; last_error = error_msg }))
171
198
else begin
172
199
(* Retry with exponential backoff *)
173
-
let delay = Config.connect_retry_delay pool.config *. (2.0 ** float_of_int (attempt - 1)) in
200
+
let delay =
201
+
Config.connect_retry_delay pool.config
202
+
*. (2.0 ** float_of_int (attempt - 1))
203
+
in
174
204
Eio.Time.sleep pool.clock delay;
175
205
create_connection_with_retry pool endpoint (attempt + 1) error_msg
176
206
end
177
207
| e ->
178
208
(* Other errors - retry with backoff *)
179
209
let error_msg = Printexc.to_string e in
180
-
Log.warn (fun m -> m "Connection attempt %d to %a failed: %s"
181
-
attempt Endpoint.pp endpoint error_msg);
210
+
Log.warn (fun m ->
211
+
m "Connection attempt %d to %a failed: %s" attempt Endpoint.pp
212
+
endpoint error_msg);
182
213
if attempt < Config.connect_retry_count pool.config then (
183
-
let delay = Config.connect_retry_delay pool.config *. (2.0 ** float_of_int (attempt - 1)) in
214
+
let delay =
215
+
Config.connect_retry_delay pool.config
216
+
*. (2.0 ** float_of_int (attempt - 1))
217
+
in
184
218
Eio.Time.sleep pool.clock delay;
185
-
create_connection_with_retry pool endpoint (attempt + 1) error_msg
186
-
) else
187
-
raise (Pool_error (Connection_failed { endpoint; attempts = attempt; last_error = error_msg }))
219
+
create_connection_with_retry pool endpoint (attempt + 1) error_msg)
220
+
else
221
+
raise
222
+
(Pool_error
223
+
(Connection_failed
224
+
{ endpoint; attempts = attempt; last_error = error_msg }))
188
225
189
226
let create_connection (pool : ('clock, 'net) internal) endpoint =
190
227
create_connection_with_retry pool endpoint 1 "No attempts made"
···
198
235
let age = now -. Connection.created_at conn in
199
236
let max_lifetime = Config.max_connection_lifetime pool.config in
200
237
if age > max_lifetime then begin
201
-
Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max lifetime (%.2fs > %.2fs)"
202
-
Endpoint.pp (Connection.endpoint conn) age max_lifetime);
238
+
Log.debug (fun m ->
239
+
m "Connection to %a unhealthy: exceeded max lifetime (%.2fs > %.2fs)"
240
+
Endpoint.pp (Connection.endpoint conn) age max_lifetime);
203
241
false
204
242
end
205
-
206
243
(* Check idle time *)
207
-
else begin
244
+
else begin
208
245
let max_idle = Config.max_idle_time pool.config in
209
-
if (now -. Connection.last_used conn) > max_idle then begin
246
+
if now -. Connection.last_used conn > max_idle then begin
210
247
let idle_time = now -. Connection.last_used conn in
211
-
Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max idle time (%.2fs > %.2fs)"
212
-
Endpoint.pp (Connection.endpoint conn) idle_time max_idle);
213
-
false
214
-
end
215
-
216
-
(* Check use count *)
217
-
else if (match Config.max_connection_uses pool.config with
218
-
| Some max -> Connection.use_count conn >= max
219
-
| None -> false) then begin
220
-
Log.debug (fun m -> m "Connection to %a unhealthy: exceeded max use count (%d)"
221
-
Endpoint.pp (Connection.endpoint conn) (Connection.use_count conn));
248
+
Log.debug (fun m ->
249
+
m "Connection to %a unhealthy: exceeded max idle time (%.2fs > %.2fs)"
250
+
Endpoint.pp (Connection.endpoint conn) idle_time max_idle);
222
251
false
223
-
end
224
-
225
-
(* Optional: custom health check *)
226
-
else if (match Config.health_check pool.config with
227
-
| Some check ->
228
-
(try
229
-
let healthy = check (Connection.flow conn) in
230
-
if not healthy then
231
-
Log.debug (fun m -> m "Connection to %a failed custom health check"
232
-
Endpoint.pp (Connection.endpoint conn));
233
-
not healthy
234
-
with e ->
235
-
Log.debug (fun m -> m "Connection to %a health check raised exception: %s"
236
-
Endpoint.pp (Connection.endpoint conn) (Printexc.to_string e));
237
-
true) (* Exception in health check = unhealthy *)
238
-
| None -> false) then
252
+
end (* Check use count *)
253
+
else if
254
+
match Config.max_connection_uses pool.config with
255
+
| Some max -> Connection.use_count conn >= max
256
+
| None -> false
257
+
then begin
258
+
Log.debug (fun m ->
259
+
m "Connection to %a unhealthy: exceeded max use count (%d)"
260
+
Endpoint.pp (Connection.endpoint conn)
261
+
(Connection.use_count conn));
239
262
false
240
-
241
-
(* Optional: check if socket still connected *)
263
+
end (* Optional: custom health check *)
264
+
else if
265
+
match Config.health_check pool.config with
266
+
| Some check -> (
267
+
try
268
+
let healthy = check (Connection.flow conn) in
269
+
if not healthy then
270
+
Log.debug (fun m ->
271
+
m "Connection to %a failed custom health check" Endpoint.pp
272
+
(Connection.endpoint conn));
273
+
not healthy
274
+
with e ->
275
+
Log.debug (fun m ->
276
+
m "Connection to %a health check raised exception: %s"
277
+
Endpoint.pp (Connection.endpoint conn) (Printexc.to_string e));
278
+
true (* Exception in health check = unhealthy *))
279
+
| None -> false
280
+
then false (* Optional: check if socket still connected *)
242
281
else if check_readable then
243
282
try
244
283
(* TODO avsm: a sockopt for this? *)
245
284
true
246
-
with
247
-
| _ -> false
248
-
285
+
with _ -> false
249
286
else begin
250
-
Log.debug (fun m -> m "Connection to %a is healthy (age=%.2fs, idle=%.2fs, uses=%d)"
251
-
Endpoint.pp (Connection.endpoint conn)
252
-
age
253
-
(now -. Connection.last_used conn)
254
-
(Connection.use_count conn));
287
+
Log.debug (fun m ->
288
+
m "Connection to %a is healthy (age=%.2fs, idle=%.2fs, uses=%d)"
289
+
Endpoint.pp (Connection.endpoint conn) age
290
+
(now -. Connection.last_used conn)
291
+
(Connection.use_count conn));
255
292
true
256
293
end
257
294
end
···
259
296
(** {1 Internal Pool Operations} *)
260
297
261
298
let close_internal (pool : ('clock, 'net) internal) conn =
262
-
Log.debug (fun m -> m "Closing connection to %a (age=%.2fs, uses=%d)"
263
-
Endpoint.pp (Connection.endpoint conn)
264
-
(get_time pool -. Connection.created_at conn)
265
-
(Connection.use_count conn));
299
+
Log.debug (fun m ->
300
+
m "Closing connection to %a (age=%.2fs, uses=%d)" Endpoint.pp
301
+
(Connection.endpoint conn)
302
+
(get_time pool -. Connection.created_at conn)
303
+
(Connection.use_count conn));
266
304
267
305
Eio.Cancel.protect (fun () ->
268
-
try
269
-
Eio.Flow.close (Connection.flow conn)
270
-
with _ -> ()
271
-
);
306
+
try Eio.Flow.close (Connection.flow conn) with _ -> ());
272
307
273
308
(* Call hook if configured *)
274
-
Option.iter (fun f -> f (Connection.endpoint conn)) (Config.on_connection_closed pool.config)
309
+
Option.iter
310
+
(fun f -> f (Connection.endpoint conn))
311
+
(Config.on_connection_closed pool.config)
275
312
276
313
let get_or_create_endpoint_pool (pool : ('clock, 'net) internal) endpoint =
277
-
Log.debug (fun m -> m "Getting or creating endpoint pool for %a" Endpoint.pp endpoint);
314
+
Log.debug (fun m ->
315
+
m "Getting or creating endpoint pool for %a" Endpoint.pp endpoint);
278
316
279
317
(* First try with read lock *)
280
-
match Eio.Mutex.use_ro pool.endpoints_mutex (fun () ->
281
-
Hashtbl.find_opt pool.endpoints endpoint
282
-
) with
318
+
match
319
+
Eio.Mutex.use_ro pool.endpoints_mutex (fun () ->
320
+
Hashtbl.find_opt pool.endpoints endpoint)
321
+
with
283
322
| Some ep_pool ->
284
-
Log.debug (fun m -> m "Found existing endpoint pool for %a" Endpoint.pp endpoint);
323
+
Log.debug (fun m ->
324
+
m "Found existing endpoint pool for %a" Endpoint.pp endpoint);
285
325
ep_pool
286
326
| None ->
287
-
Log.debug (fun m -> m "No existing pool, need to create for %a" Endpoint.pp endpoint);
327
+
Log.debug (fun m ->
328
+
m "No existing pool, need to create for %a" Endpoint.pp endpoint);
288
329
(* Need to create - use write lock *)
289
330
Eio.Mutex.use_rw ~protect:true pool.endpoints_mutex (fun () ->
290
-
(* Check again in case another fiber created it *)
291
-
match Hashtbl.find_opt pool.endpoints endpoint with
292
-
| Some ep_pool ->
293
-
Log.debug (fun m -> m "Another fiber created pool for %a" Endpoint.pp endpoint);
294
-
ep_pool
295
-
| None ->
331
+
(* Check again in case another fiber created it *)
332
+
match Hashtbl.find_opt pool.endpoints endpoint with
333
+
| Some ep_pool ->
334
+
Log.debug (fun m ->
335
+
m "Another fiber created pool for %a" Endpoint.pp endpoint);
336
+
ep_pool
337
+
| None ->
296
338
(* Create new endpoint pool *)
297
339
let stats = create_endp_stats () in
298
340
let mutex = Eio.Mutex.create () in
299
341
300
-
Log.info (fun m -> m "Creating new endpoint pool for %a (max_connections=%d)"
301
-
Endpoint.pp endpoint (Config.max_connections_per_endpoint pool.config));
342
+
Log.info (fun m ->
343
+
m "Creating new endpoint pool for %a (max_connections=%d)"
344
+
Endpoint.pp endpoint
345
+
(Config.max_connections_per_endpoint pool.config));
302
346
303
-
Log.debug (fun m -> m "About to create Eio.Pool for %a" Endpoint.pp endpoint);
347
+
Log.debug (fun m ->
348
+
m "About to create Eio.Pool for %a" Endpoint.pp endpoint);
304
349
305
-
let eio_pool = Eio.Pool.create
306
-
(Config.max_connections_per_endpoint pool.config)
307
-
~validate:(fun conn ->
308
-
Log.debug (fun m -> m "Validate called for connection to %a" Endpoint.pp endpoint);
309
-
(* Called before reusing from pool *)
310
-
let healthy = is_healthy pool ~check_readable:false conn in
350
+
let eio_pool =
351
+
Eio.Pool.create
352
+
(Config.max_connections_per_endpoint pool.config)
353
+
~validate:(fun conn ->
354
+
Log.debug (fun m ->
355
+
m "Validate called for connection to %a" Endpoint.pp
356
+
endpoint);
357
+
(* Called before reusing from pool *)
358
+
let healthy = is_healthy pool ~check_readable:false conn in
311
359
312
-
if healthy then (
313
-
Log.debug (fun m -> m "Reusing connection to %a from pool" Endpoint.pp endpoint);
360
+
if healthy then (
361
+
Log.debug (fun m ->
362
+
m "Reusing connection to %a from pool" Endpoint.pp
363
+
endpoint);
314
364
315
-
(* Update stats for reuse *)
316
-
Eio.Mutex.use_rw ~protect:true mutex (fun () ->
317
-
stats.total_reused <- stats.total_reused + 1
318
-
);
365
+
(* Update stats for reuse *)
366
+
Eio.Mutex.use_rw ~protect:true mutex (fun () ->
367
+
stats.total_reused <- stats.total_reused + 1);
319
368
320
-
(* Call hook if configured *)
321
-
Option.iter (fun f -> f endpoint) (Config.on_connection_reused pool.config);
369
+
(* Call hook if configured *)
370
+
Option.iter
371
+
(fun f -> f endpoint)
372
+
(Config.on_connection_reused pool.config);
322
373
323
-
(* Run health check if configured *)
324
-
match Config.health_check pool.config with
325
-
| Some check ->
326
-
(try check (Connection.flow conn)
327
-
with _ -> false)
328
-
| None -> true
329
-
) else begin
330
-
Log.debug (fun m -> m "Connection to %a failed validation, creating new one" Endpoint.pp endpoint);
331
-
false
332
-
end
333
-
)
334
-
~dispose:(fun conn ->
335
-
(* Called when removing from pool *)
336
-
Eio.Cancel.protect (fun () ->
337
-
close_internal pool conn;
374
+
(* Run health check if configured *)
375
+
match Config.health_check pool.config with
376
+
| Some check -> (
377
+
try check (Connection.flow conn) with _ -> false)
378
+
| None -> true)
379
+
else begin
380
+
Log.debug (fun m ->
381
+
m
382
+
"Connection to %a failed validation, creating new \
383
+
one"
384
+
Endpoint.pp endpoint);
385
+
false
386
+
end)
387
+
~dispose:(fun conn ->
388
+
(* Called when removing from pool *)
389
+
Eio.Cancel.protect (fun () ->
390
+
close_internal pool conn;
338
391
339
-
(* Update stats *)
340
-
Eio.Mutex.use_rw ~protect:true mutex (fun () ->
341
-
stats.total_closed <- stats.total_closed + 1
342
-
)
343
-
)
344
-
)
345
-
(fun () ->
346
-
Log.debug (fun m -> m "Factory function called for %a" Endpoint.pp endpoint);
347
-
try
348
-
let conn = create_connection pool endpoint in
392
+
(* Update stats *)
393
+
Eio.Mutex.use_rw ~protect:true mutex (fun () ->
394
+
stats.total_closed <- stats.total_closed + 1)))
395
+
(fun () ->
396
+
Log.debug (fun m ->
397
+
m "Factory function called for %a" Endpoint.pp endpoint);
398
+
try
399
+
let conn = create_connection pool endpoint in
349
400
350
-
Log.debug (fun m -> m "Connection created successfully for %a" Endpoint.pp endpoint);
401
+
Log.debug (fun m ->
402
+
m "Connection created successfully for %a" Endpoint.pp
403
+
endpoint);
351
404
352
-
(* Update stats *)
353
-
Eio.Mutex.use_rw ~protect:true mutex (fun () ->
354
-
stats.total_created <- stats.total_created + 1
355
-
);
405
+
(* Update stats *)
406
+
Eio.Mutex.use_rw ~protect:true mutex (fun () ->
407
+
stats.total_created <- stats.total_created + 1);
356
408
357
-
(* Call hook if configured *)
358
-
Option.iter (fun f -> f endpoint) (Config.on_connection_created pool.config);
409
+
(* Call hook if configured *)
410
+
Option.iter
411
+
(fun f -> f endpoint)
412
+
(Config.on_connection_created pool.config);
359
413
360
-
conn
361
-
with e ->
362
-
Log.err (fun m -> m "Factory function failed for %a: %s"
363
-
Endpoint.pp endpoint (Printexc.to_string e));
364
-
(* Update error stats *)
365
-
Eio.Mutex.use_rw ~protect:true mutex (fun () ->
366
-
stats.errors <- stats.errors + 1
367
-
);
368
-
raise e
369
-
)
414
+
conn
415
+
with e ->
416
+
Log.err (fun m ->
417
+
m "Factory function failed for %a: %s" Endpoint.pp
418
+
endpoint (Printexc.to_string e));
419
+
(* Update error stats *)
420
+
Eio.Mutex.use_rw ~protect:true mutex (fun () ->
421
+
stats.errors <- stats.errors + 1);
422
+
raise e)
370
423
in
371
424
372
-
Log.debug (fun m -> m "Eio.Pool created successfully for %a" Endpoint.pp endpoint);
425
+
Log.debug (fun m ->
426
+
m "Eio.Pool created successfully for %a" Endpoint.pp endpoint);
373
427
374
-
let ep_pool = {
375
-
pool = eio_pool;
376
-
stats;
377
-
mutex;
378
-
} in
428
+
let ep_pool = { pool = eio_pool; stats; mutex } in
379
429
380
430
Hashtbl.add pool.endpoints endpoint ep_pool;
381
-
Log.debug (fun m -> m "Endpoint pool added to hashtable for %a" Endpoint.pp endpoint);
382
-
ep_pool
383
-
)
431
+
Log.debug (fun m ->
432
+
m "Endpoint pool added to hashtable for %a" Endpoint.pp
433
+
endpoint);
434
+
ep_pool)
384
435
385
436
(** {1 Public API - Pool Creation} *)
386
437
387
-
let create ~sw ~(net : 'net Eio.Net.t) ~(clock : 'clock Eio.Time.clock) ?tls ?(config = Config.default) () : t =
388
-
Log.info (fun m -> m "Creating new connection pool (max_per_endpoint=%d, max_idle=%.1fs, max_lifetime=%.1fs)"
389
-
(Config.max_connections_per_endpoint config)
390
-
(Config.max_idle_time config)
391
-
(Config.max_connection_lifetime config));
438
+
let create ~sw ~(net : 'net Eio.Net.t) ~(clock : 'clock Eio.Time.clock) ?tls
439
+
?(config = Config.default) () : t =
440
+
Log.info (fun m ->
441
+
m
442
+
"Creating new connection pool (max_per_endpoint=%d, max_idle=%.1fs, \
443
+
max_lifetime=%.1fs)"
444
+
(Config.max_connections_per_endpoint config)
445
+
(Config.max_idle_time config)
446
+
(Config.max_connection_lifetime config));
392
447
393
-
let pool = {
394
-
sw;
395
-
net;
396
-
clock;
397
-
config;
398
-
tls;
399
-
endpoints = Hashtbl.create 16;
400
-
endpoints_mutex = Eio.Mutex.create ();
401
-
} in
448
+
let pool =
449
+
{
450
+
sw;
451
+
net;
452
+
clock;
453
+
config;
454
+
tls;
455
+
endpoints = Hashtbl.create 16;
456
+
endpoints_mutex = Eio.Mutex.create ();
457
+
}
458
+
in
402
459
403
460
(* Auto-cleanup on switch release *)
404
461
Eio.Switch.on_release sw (fun () ->
405
-
Eio.Cancel.protect (fun () ->
406
-
Log.info (fun m -> m "Closing connection pool");
407
-
(* Close all idle connections - active ones will be cleaned up by switch *)
408
-
Hashtbl.iter (fun _endpoint _ep_pool ->
409
-
(* Connections are bound to the switch and will be auto-closed *)
410
-
()
411
-
) pool.endpoints;
462
+
Eio.Cancel.protect (fun () ->
463
+
Log.info (fun m -> m "Closing connection pool");
464
+
(* Close all idle connections - active ones will be cleaned up by switch *)
465
+
Hashtbl.iter
466
+
(fun _endpoint _ep_pool ->
467
+
(* Connections are bound to the switch and will be auto-closed *)
468
+
())
469
+
pool.endpoints;
412
470
413
-
Hashtbl.clear pool.endpoints
414
-
)
415
-
);
471
+
Hashtbl.clear pool.endpoints));
416
472
417
473
T pool
418
474
···
424
480
425
481
(* Increment active count *)
426
482
Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->
427
-
ep_pool.stats.active <- ep_pool.stats.active + 1
428
-
);
483
+
ep_pool.stats.active <- ep_pool.stats.active + 1);
429
484
430
485
Fun.protect
431
486
~finally:(fun () ->
432
487
(* Decrement active count *)
433
488
Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->
434
-
ep_pool.stats.active <- ep_pool.stats.active - 1
435
-
);
436
-
Log.debug (fun m -> m "Released connection to %a" Endpoint.pp endpoint)
437
-
)
489
+
ep_pool.stats.active <- ep_pool.stats.active - 1);
490
+
Log.debug (fun m -> m "Released connection to %a" Endpoint.pp endpoint))
438
491
(fun () ->
439
492
(* Use Eio.Pool for resource management *)
440
493
Eio.Pool.use ep_pool.pool (fun conn ->
441
-
Log.debug (fun m -> m "Using connection to %a (uses=%d)"
442
-
Endpoint.pp endpoint (Connection.use_count conn));
494
+
Log.debug (fun m ->
495
+
m "Using connection to %a (uses=%d)" Endpoint.pp endpoint
496
+
(Connection.use_count conn));
443
497
444
-
(* Update last used time and use count *)
445
-
Connection.update_usage conn ~now:(get_time pool);
498
+
(* Update last used time and use count *)
499
+
Connection.update_usage conn ~now:(get_time pool);
446
500
447
-
(* Update idle stats (connection taken from idle pool) *)
448
-
Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->
449
-
ep_pool.stats.idle <- max 0 (ep_pool.stats.idle - 1)
450
-
);
501
+
(* Update idle stats (connection taken from idle pool) *)
502
+
Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->
503
+
ep_pool.stats.idle <- max 0 (ep_pool.stats.idle - 1));
451
504
452
-
try
453
-
let result = f conn.flow in
505
+
try
506
+
let result = f conn.flow in
454
507
455
-
(* Success - connection will be returned to pool by Eio.Pool *)
456
-
(* Update idle stats (connection returned to idle pool) *)
457
-
Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->
458
-
ep_pool.stats.idle <- ep_pool.stats.idle + 1
459
-
);
508
+
(* Success - connection will be returned to pool by Eio.Pool *)
509
+
(* Update idle stats (connection returned to idle pool) *)
510
+
Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->
511
+
ep_pool.stats.idle <- ep_pool.stats.idle + 1);
460
512
461
-
result
462
-
with e ->
463
-
(* Error - close connection so it won't be reused *)
464
-
Log.warn (fun m -> m "Error using connection to %a: %s"
465
-
Endpoint.pp endpoint (Printexc.to_string e));
466
-
close_internal pool conn;
513
+
result
514
+
with e ->
515
+
(* Error - close connection so it won't be reused *)
516
+
Log.warn (fun m ->
517
+
m "Error using connection to %a: %s" Endpoint.pp endpoint
518
+
(Printexc.to_string e));
519
+
close_internal pool conn;
467
520
468
-
(* Update error stats *)
469
-
Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->
470
-
ep_pool.stats.errors <- ep_pool.stats.errors + 1
471
-
);
521
+
(* Update error stats *)
522
+
Eio.Mutex.use_rw ~protect:true ep_pool.mutex (fun () ->
523
+
ep_pool.stats.errors <- ep_pool.stats.errors + 1);
472
524
473
-
raise e
474
-
)
475
-
)
525
+
raise e))
476
526
477
527
(** {1 Public API - Statistics} *)
478
528
479
529
let stats (T pool) endpoint =
480
530
match Hashtbl.find_opt pool.endpoints endpoint with
481
531
| Some ep_pool ->
482
-
Eio.Mutex.use_ro ep_pool.mutex (fun () ->
483
-
snapshot_stats ep_pool.stats
484
-
)
532
+
Eio.Mutex.use_ro ep_pool.mutex (fun () -> snapshot_stats ep_pool.stats)
485
533
| None ->
486
534
(* No pool for this endpoint yet *)
487
-
Stats.make
488
-
~active:0
489
-
~idle:0
490
-
~total_created:0
491
-
~total_reused:0
492
-
~total_closed:0
493
-
~errors:0
535
+
Stats.make ~active:0 ~idle:0 ~total_created:0 ~total_reused:0
536
+
~total_closed:0 ~errors:0
494
537
495
538
let all_stats (T pool) =
496
539
Eio.Mutex.use_ro pool.endpoints_mutex (fun () ->
497
-
Hashtbl.fold (fun endpoint ep_pool acc ->
498
-
let stats = Eio.Mutex.use_ro ep_pool.mutex (fun () ->
499
-
snapshot_stats ep_pool.stats
500
-
) in
501
-
(endpoint, stats) :: acc
502
-
) pool.endpoints []
503
-
)
540
+
Hashtbl.fold
541
+
(fun endpoint ep_pool acc ->
542
+
let stats =
543
+
Eio.Mutex.use_ro ep_pool.mutex (fun () ->
544
+
snapshot_stats ep_pool.stats)
545
+
in
546
+
(endpoint, stats) :: acc)
547
+
pool.endpoints [])
504
548
505
549
(** {1 Public API - Pool Management} *)
506
550
···
509
553
match Hashtbl.find_opt pool.endpoints endpoint with
510
554
| Some _ep_pool ->
511
555
Eio.Cancel.protect (fun () ->
512
-
(* Remove endpoint pool from hashtable *)
513
-
(* Idle connections will be discarded *)
514
-
(* Active connections will be closed when returned *)
515
-
Eio.Mutex.use_rw ~protect:true pool.endpoints_mutex (fun () ->
516
-
Hashtbl.remove pool.endpoints endpoint
517
-
)
518
-
)
556
+
(* Remove endpoint pool from hashtable *)
557
+
(* Idle connections will be discarded *)
558
+
(* Active connections will be closed when returned *)
559
+
Eio.Mutex.use_rw ~protect:true pool.endpoints_mutex (fun () ->
560
+
Hashtbl.remove pool.endpoints endpoint))
519
561
| None ->
520
-
Log.debug (fun m -> m "No endpoint pool found for %a" Endpoint.pp endpoint)
562
+
Log.debug (fun m ->
563
+
m "No endpoint pool found for %a" Endpoint.pp endpoint)
+41
-49
lib/conpool.mli
+41
-49
lib/conpool.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Conpool - Protocol-agnostic TCP/IP connection pooling library for Eio *)
2
7
3
8
(** {1 Logging} *)
···
6
11
(** Logs source for the main connection pool. Configure logging with:
7
12
{[
8
13
Logs.Src.set_level Conpool.src (Some Logs.Debug);
9
-
Logs.set_reporter (Logs_fmt.reporter ());
14
+
Logs.set_reporter (Logs_fmt.reporter ())
10
15
]}
11
16
12
17
Each submodule also exposes its own log source for fine-grained control:
13
18
- {!Endpoint.src} - endpoint operations
14
19
- {!Tls_config.src} - TLS configuration
15
-
- {!Config.src} - pool configuration
16
-
*)
20
+
- {!Config.src} - pool configuration *)
17
21
18
22
(** {1 Core Types} *)
19
23
20
-
(** Network endpoint representation *)
21
24
module Endpoint : module type of Endpoint
25
+
(** Network endpoint representation *)
22
26
23
-
(** TLS configuration for connection pools *)
24
27
module Tls_config : module type of Tls_config
28
+
(** TLS configuration for connection pools *)
25
29
26
-
(** Configuration for connection pools *)
27
30
module Config : module type of Config
31
+
(** Configuration for connection pools *)
28
32
33
+
module Stats : module type of Stats
29
34
(** Statistics for connection pool endpoints *)
30
-
module Stats : module type of Stats
31
35
32
-
(** Cmdliner terms for connection pool configuration *)
33
36
module Cmd : module type of Cmd
37
+
(** Cmdliner terms for connection pool configuration *)
34
38
35
39
(** {1 Errors} *)
36
40
37
41
type error =
38
42
| Dns_resolution_failed of { hostname : string }
39
-
(** DNS resolution failed for the given hostname *)
40
-
41
-
| Connection_failed of { endpoint : Endpoint.t; attempts : int; last_error : string }
42
-
(** Failed to establish connection after all retry attempts *)
43
-
43
+
(** DNS resolution failed for the given hostname *)
44
+
| Connection_failed of {
45
+
endpoint : Endpoint.t;
46
+
attempts : int;
47
+
last_error : string;
48
+
} (** Failed to establish connection after all retry attempts *)
44
49
| Connection_timeout of { endpoint : Endpoint.t; timeout : float }
45
-
(** Connection attempt timed out *)
46
-
47
-
| Invalid_config of string
48
-
(** Invalid configuration parameter *)
49
-
50
-
| Invalid_endpoint of string
51
-
(** Invalid endpoint specification *)
50
+
(** Connection attempt timed out *)
51
+
| Invalid_config of string (** Invalid configuration parameter *)
52
+
| Invalid_endpoint of string (** Invalid endpoint specification *)
52
53
53
54
exception Pool_error of error
54
55
(** Exception raised by pool operations.
···
70
71
clock:'clock Eio.Time.clock ->
71
72
?tls:Tls_config.t ->
72
73
?config:Config.t ->
73
-
unit -> t
74
-
(** Create connection pool bound to switch.
75
-
All connections will be closed when switch is released.
74
+
unit ->
75
+
t
76
+
(** Create connection pool bound to switch. All connections will be closed when
77
+
switch is released.
76
78
77
79
@param sw Switch for resource management
78
80
@param net Network interface for creating connections
79
81
@param clock Clock for timeouts and time-based validation
80
82
@param tls Optional TLS configuration applied to all connections
81
-
@param config Optional pool configuration (uses Config.default if not provided) *)
83
+
@param config
84
+
Optional pool configuration (uses Config.default if not provided) *)
82
85
83
86
(** {1 Connection Usage} *)
84
87
···
90
93
(** Acquire connection, use it, automatically release back to pool.
91
94
92
95
If idle connection available and healthy:
93
-
- Reuse from pool (validates health first)
94
-
Else:
95
-
- Create new connection (may block if endpoint at limit)
96
+
- Reuse from pool (validates health first) Else:
97
+
- Create new connection (may block if endpoint at limit)
96
98
97
-
On success: connection returned to pool for reuse
98
-
On error: connection closed, not returned to pool
99
+
On success: connection returned to pool for reuse On error: connection
100
+
closed, not returned to pool
99
101
100
102
Example:
101
103
{[
102
104
let endpoint = Conpool.Endpoint.make ~host:"example.com" ~port:443 in
103
105
Conpool.with_connection pool endpoint (fun conn ->
104
-
(* Use conn for HTTP request, Redis command, etc. *)
105
-
Eio.Flow.copy_string "GET / HTTP/1.1\r\n\r\n" conn;
106
-
let buf = Eio.Buf_read.of_flow conn ~max_size:4096 in
107
-
Eio.Buf_read.take_all buf
108
-
)
109
-
]}
110
-
*)
106
+
(* Use conn for HTTP request, Redis command, etc. *)
107
+
Eio.Flow.copy_string "GET / HTTP/1.1\r\n\r\n" conn;
108
+
let buf = Eio.Buf_read.of_flow conn ~max_size:4096 in
109
+
Eio.Buf_read.take_all buf)
110
+
]} *)
111
111
112
112
(** {1 Statistics & Monitoring} *)
113
113
114
-
val stats :
115
-
t ->
116
-
Endpoint.t ->
117
-
Stats.t
114
+
val stats : t -> Endpoint.t -> Stats.t
118
115
(** Get statistics for specific endpoint *)
119
116
120
-
val all_stats :
121
-
t ->
122
-
(Endpoint.t * Stats.t) list
117
+
val all_stats : t -> (Endpoint.t * Stats.t) list
123
118
(** Get statistics for all endpoints in pool *)
124
119
125
120
(** {1 Pool Management} *)
126
121
127
-
val clear_endpoint :
128
-
t ->
129
-
Endpoint.t ->
130
-
unit
122
+
val clear_endpoint : t -> Endpoint.t -> unit
131
123
(** Clear all cached connections for a specific endpoint.
132
124
133
125
This removes the endpoint from the pool, discarding all idle connections.
134
126
Active connections will continue to work but won't be returned to the pool.
135
127
136
-
Use this when you know an endpoint's connections are no longer valid
137
-
(e.g., server restarted, network reconfigured, credentials changed).
128
+
Use this when you know an endpoint's connections are no longer valid (e.g.,
129
+
server restarted, network reconfigured, credentials changed).
138
130
139
131
The pool will be automatically cleaned up when its switch is released. *)
+14
-15
lib/endpoint.ml
+14
-15
lib/endpoint.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Network endpoint representation *)
2
7
3
-
let src = Logs.Src.create "conpool.endpoint" ~doc:"Connection pool endpoint operations"
8
+
let src =
9
+
Logs.Src.create "conpool.endpoint" ~doc:"Connection pool endpoint operations"
10
+
4
11
module Log = (val Logs.src_log src : Logs.LOG)
5
12
6
-
type t = {
7
-
host : string;
8
-
port : int;
9
-
}
13
+
type t = { host : string; port : int }
10
14
11
15
let make ~host ~port =
12
16
(* Validate port range *)
13
17
if port < 1 || port > 65535 then
14
-
invalid_arg (Printf.sprintf "Invalid port number: %d (must be 1-65535)" port);
18
+
invalid_arg
19
+
(Printf.sprintf "Invalid port number: %d (must be 1-65535)" port);
15
20
16
21
(* Validate hostname is not empty *)
17
-
if String.trim host = "" then
18
-
invalid_arg "Hostname cannot be empty";
22
+
if String.trim host = "" then invalid_arg "Hostname cannot be empty";
19
23
20
24
Log.debug (fun m -> m "Creating endpoint: %s:%d" host port);
21
25
{ host; port }
22
26
23
27
let host t = t.host
24
28
let port t = t.port
25
-
26
-
let equal t1 t2 =
27
-
String.equal t1.host t2.host && t1.port = t2.port
28
-
29
-
let hash t =
30
-
Hashtbl.hash (t.host, t.port)
31
-
29
+
let equal t1 t2 = String.equal t1.host t2.host && t1.port = t2.port
30
+
let hash t = Hashtbl.hash (t.host, t.port)
32
31
let pp = Fmt.of_to_string (fun t -> Printf.sprintf "%s:%d" t.host t.port)
+7
-3
lib/endpoint.mli
+7
-3
lib/endpoint.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Network endpoint representation *)
2
7
3
8
(** {1 Logging} *)
···
5
10
val src : Logs.Src.t
6
11
(** Logs source for endpoint operations. Configure logging with:
7
12
{[
8
-
Logs.Src.set_level Conpool.Endpoint.src (Some Logs.Debug);
9
-
]}
10
-
*)
13
+
Logs.Src.set_level Conpool.Endpoint.src (Some Logs.Debug)
14
+
]} *)
11
15
12
16
(** {1 Type} *)
13
17
+6
-6
lib/stats.ml
+6
-6
lib/stats.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Statistics for connection pool endpoints *)
2
7
3
8
type t = {
···
28
33
- Reused: %d@,\
29
34
- Closed: %d@,\
30
35
- Errors: %d@]"
31
-
t.active
32
-
t.idle
33
-
t.total_created
34
-
t.total_reused
35
-
t.total_closed
36
-
t.errors
36
+
t.active t.idle t.total_created t.total_reused t.total_closed t.errors
+5
lib/stats.mli
+5
lib/stats.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** Statistics for connection pool endpoints *)
2
7
3
8
(** {1 Type} *)
+9
-6
lib/tls_config.ml
+9
-6
lib/tls_config.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** TLS configuration for connection pools *)
2
7
3
8
let src = Logs.Src.create "conpool.tls" ~doc:"Connection pool TLS configuration"
9
+
4
10
module Log = (val Logs.src_log src : Logs.LOG)
5
11
6
-
type t = {
7
-
config : Tls.Config.client;
8
-
servername : string option;
9
-
}
12
+
type t = { config : Tls.Config.client; servername : string option }
10
13
11
14
let make ~config ?servername () =
12
15
Log.debug (fun m ->
13
-
m "Creating TLS config with servername: %s"
14
-
(match servername with Some s -> s | None -> "<default>"));
16
+
m "Creating TLS config with servername: %s"
17
+
(match servername with Some s -> s | None -> "<default>"));
15
18
{ config; servername }
16
19
17
20
let config t = t.config
+9
-4
lib/tls_config.mli
+9
-4
lib/tls_config.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
1
6
(** TLS configuration for connection pools *)
2
7
3
8
(** {1 Logging} *)
···
5
10
val src : Logs.Src.t
6
11
(** Logs source for TLS configuration operations. Configure logging with:
7
12
{[
8
-
Logs.Src.set_level Conpool.Tls_config.src (Some Logs.Debug);
9
-
]}
10
-
*)
13
+
Logs.Src.set_level Conpool.Tls_config.src (Some Logs.Debug)
14
+
]} *)
11
15
12
16
(** {1 Type} *)
13
17
···
20
24
(** Create TLS configuration.
21
25
22
26
@param config TLS client configuration for all connections
23
-
@param servername Optional SNI server name override. If [None], uses the endpoint's hostname
27
+
@param servername
28
+
Optional SNI server name override. If [None], uses the endpoint's hostname
24
29
*)
25
30
26
31
(** {1 Accessors} *)