anil.recoil.org
TCP/TLS connection pooling for Eio
eio-context
+72
-69
+51
-53
lib/conpool.ml
+51
-53
lib/conpool.ml
···
28
28
| Invalid_config of string
29
29
| Invalid_endpoint of string
30
30
31
-
exception Pool_error of error
32
-
33
31
let pp_error ppf = function
34
32
| Dns_resolution_failed { hostname } ->
35
33
Fmt.pf ppf "DNS resolution failed for hostname: %s" hostname
···
114
112
115
113
let resolve_endpoint (pool : ('clock, 'net) internal) endpoint =
116
114
Log.debug (fun m -> m "Resolving %a..." Endpoint.pp endpoint);
117
-
let addrs =
118
-
Eio.Net.getaddrinfo_stream pool.net (Endpoint.host endpoint)
119
-
~service:(string_of_int (Endpoint.port endpoint))
120
-
in
121
-
Log.debug (fun m -> m "Got address list for %a" Endpoint.pp endpoint);
122
-
match addrs with
123
-
| addr :: _ ->
124
-
Log.debug (fun m ->
125
-
m "Resolved %a to %a" Endpoint.pp endpoint Eio.Net.Sockaddr.pp addr);
126
-
addr
127
-
| [] ->
128
-
Log.err (fun m ->
129
-
m "Failed to resolve hostname: %s" (Endpoint.host endpoint));
130
-
raise
131
-
(Pool_error
132
-
(Dns_resolution_failed { hostname = Endpoint.host endpoint }))
115
+
try
116
+
let addrs =
117
+
Eio.Net.getaddrinfo_stream pool.net (Endpoint.host endpoint)
118
+
~service:(string_of_int (Endpoint.port endpoint))
119
+
in
120
+
Log.debug (fun m -> m "Got address list for %a" Endpoint.pp endpoint);
121
+
match addrs with
122
+
| addr :: _ ->
123
+
Log.debug (fun m ->
124
+
m "Resolved %a to %a" Endpoint.pp endpoint Eio.Net.Sockaddr.pp addr);
125
+
addr
126
+
| [] ->
127
+
Log.err (fun m ->
128
+
m "Failed to resolve hostname: %s" (Endpoint.host endpoint));
129
+
raise (err (Dns_resolution_failed { hostname = Endpoint.host endpoint }))
130
+
with Eio.Io _ as ex ->
131
+
let bt = Printexc.get_raw_backtrace () in
132
+
Eio.Exn.reraise_with_context ex bt "resolving %a" Endpoint.pp endpoint
133
133
134
134
(** {1 Connection Creation with Retry} *)
135
135
···
140
140
Log.err (fun m ->
141
141
m "Failed to connect to %a after %d attempts" Endpoint.pp endpoint
142
142
retry_count);
143
-
raise
144
-
(Pool_error
145
-
(Connection_failed { endpoint; attempts = retry_count; last_error }))
143
+
raise (err (Connection_failed { endpoint; attempts = retry_count; last_error }))
146
144
end;
147
145
148
146
Log.debug (fun m ->
···
155
153
156
154
(* Connect with optional timeout *)
157
155
let socket =
158
-
match Config.connect_timeout pool.config with
159
-
| Some timeout ->
160
-
Eio.Time.with_timeout_exn pool.clock timeout (fun () ->
161
-
Eio.Net.connect ~sw:pool.sw pool.net addr)
162
-
| None -> Eio.Net.connect ~sw:pool.sw pool.net addr
156
+
try
157
+
match Config.connect_timeout pool.config with
158
+
| Some timeout ->
159
+
Eio.Time.with_timeout_exn pool.clock timeout (fun () ->
160
+
Eio.Net.connect ~sw:pool.sw pool.net addr)
161
+
| None -> Eio.Net.connect ~sw:pool.sw pool.net addr
162
+
with Eio.Io _ as ex ->
163
+
let bt = Printexc.get_raw_backtrace () in
164
+
Eio.Exn.reraise_with_context ex bt "connecting to %a" Endpoint.pp endpoint
163
165
in
164
166
165
167
Log.debug (fun m ->
···
170
172
| None ->
171
173
(socket :> connection)
172
174
| Some tls_config ->
173
-
Log.debug (fun m ->
174
-
m "Initiating TLS handshake with %a" Endpoint.pp endpoint);
175
-
let host =
176
-
Domain_name.(host_exn (of_string_exn (Endpoint.host endpoint)))
177
-
in
178
-
let tls_flow = Tls_eio.client_of_flow ~host tls_config socket in
179
-
Log.info (fun m ->
180
-
m "TLS connection established to %a" Endpoint.pp endpoint);
181
-
(tls_flow :> connection)
175
+
try
176
+
Log.debug (fun m ->
177
+
m "Initiating TLS handshake with %a" Endpoint.pp endpoint);
178
+
let host =
179
+
Domain_name.(host_exn (of_string_exn (Endpoint.host endpoint)))
180
+
in
181
+
let tls_flow = Tls_eio.client_of_flow ~host tls_config socket in
182
+
Log.info (fun m ->
183
+
m "TLS connection established to %a" Endpoint.pp endpoint);
184
+
(tls_flow :> connection)
185
+
with Eio.Io _ as ex ->
186
+
let bt = Printexc.get_raw_backtrace () in
187
+
Eio.Exn.reraise_with_context ex bt "TLS handshake with %a" Endpoint.pp endpoint
182
188
in
183
189
184
190
let now = get_time pool in
···
192
198
mutex = Eio.Mutex.create ();
193
199
}
194
200
with
195
-
| Eio.Time.Timeout as e ->
201
+
| Eio.Time.Timeout ->
196
202
Log.warn (fun m ->
197
203
m "Connection timeout to %a (attempt %d)" Endpoint.pp endpoint attempt);
198
-
let error_msg = Printexc.to_string e in
199
204
if attempt >= Config.connect_retry_count pool.config then
200
205
(* Last attempt - convert to our error type *)
201
206
match Config.connect_timeout pool.config with
202
207
| Some timeout ->
203
-
raise (Pool_error (Connection_timeout { endpoint; timeout }))
208
+
raise (err (Connection_timeout { endpoint; timeout }))
204
209
| None ->
205
-
raise
206
-
(Pool_error
207
-
(Connection_failed
208
-
{ endpoint; attempts = attempt; last_error = error_msg }))
210
+
raise (err (Connection_failed
211
+
{ endpoint; attempts = attempt; last_error = "Timeout" }))
209
212
else begin
210
213
(* Retry with exponential backoff *)
211
214
let delay =
···
213
216
*. (2.0 ** float_of_int (attempt - 1))
214
217
in
215
218
Eio.Time.sleep pool.clock delay;
216
-
create_connection_with_retry pool endpoint (attempt + 1) error_msg
219
+
create_connection_with_retry pool endpoint (attempt + 1) "Timeout"
217
220
end
218
-
| e ->
219
-
(* Other errors - retry with backoff *)
220
-
let error_msg = Printexc.to_string e in
221
+
| Eio.Io _ as ex ->
222
+
(* Eio IO errors - retry with backoff and add context on final failure *)
223
+
let error_msg = Printexc.to_string ex in
221
224
Log.warn (fun m ->
222
225
m "Connection attempt %d to %a failed: %s" attempt Endpoint.pp
223
226
endpoint error_msg);
···
229
232
Eio.Time.sleep pool.clock delay;
230
233
create_connection_with_retry pool endpoint (attempt + 1) error_msg)
231
234
else
232
-
raise
233
-
(Pool_error
234
-
(Connection_failed
235
-
{ endpoint; attempts = attempt; last_error = error_msg }))
235
+
let bt = Printexc.get_raw_backtrace () in
236
+
Eio.Exn.reraise_with_context ex bt "after %d retry attempts" attempt
236
237
237
238
let create_connection (pool : ('clock, 'net) internal) endpoint =
238
239
create_connection_with_retry pool endpoint 1 "No attempts made"
···
556
557
557
558
let with_connection t endpoint f =
558
559
Eio.Switch.run (fun sw -> f (connection ~sw t endpoint))
559
-
560
-
let with_connection_exn t endpoint f =
561
-
try with_connection t endpoint f with Pool_error e -> raise (err e)
562
560
563
561
(** {1 Public API - Statistics} *)
564
562
+21
-16
lib/conpool.mli
+21
-16
lib/conpool.mli
···
47
47
| Invalid_config of string (** Invalid configuration parameter *)
48
48
| Invalid_endpoint of string (** Invalid endpoint specification *)
49
49
50
-
exception Pool_error of error
51
-
(** Exception raised by pool operations.
50
+
type Eio.Exn.err += E of error
51
+
(** Extension of Eio's error type for connection pool errors.
52
+
53
+
Pool operations raise [Eio.Io] exceptions with context information added at
54
+
each layer. The innermost error is often [E error], wrapped with context
55
+
strings that describe the operation being performed.
52
56
53
-
Most pool operations can raise this exception. Use {!pp_error} to get
54
-
human-readable error messages. *)
57
+
Example error message:
58
+
{[
59
+
Eio.Io Conpool Dns_resolution_failed { hostname = "invalid.example" },
60
+
resolving invalid.example:443,
61
+
connecting to invalid.example:443,
62
+
after 3 retry attempts
63
+
]}
55
64
56
-
type Eio.Exn.err += E of error
57
-
(** Extension of Eio's error type for connection pool errors. *)
65
+
Use {!pp_error} to format just the error code, or let Eio format the full
66
+
exception with context. *)
58
67
59
68
val err : error -> exn
60
69
(** [err e] is [Eio.Exn.create (E e)].
61
70
62
71
This converts a connection pool error to an Eio exception, allowing it to
63
-
be handled uniformly with other Eio I/O errors. *)
72
+
be handled uniformly with other Eio I/O errors and enabling context to be
73
+
added via [Eio.Exn.reraise_with_context]. *)
64
74
65
75
val pp_error : error Fmt.t
66
-
(** Pretty-printer for error values. *)
76
+
(** Pretty-printer for error values (without context).
77
+
78
+
For full error messages including context, use [Eio.Exn.pp] or simply let
79
+
the exception be printed naturally. *)
67
80
68
81
(** {1 Connection Types} *)
69
82
···
142
155
let buf = Eio.Buf_read.of_flow conn ~max_size:4096 in
143
156
Eio.Buf_read.take_all buf)
144
157
]} *)
145
-
146
-
val with_connection_exn : t -> Endpoint.t -> (connection -> 'a) -> 'a
147
-
(** [with_connection_exn pool endpoint fn] is like {!with_connection} but
148
-
converts {!Pool_error} exceptions to [Eio.Io] exceptions for better
149
-
integration with Eio error handling.
150
-
151
-
This is useful when you want pool errors to be handled uniformly with other
152
-
Eio I/O errors. *)
153
158
154
159
(** {1 Statistics & Monitoring} *)
155
160