commit 42cec69c8a82040c347b981bb467c577ac631910 · anil.recoil.org/ocaml-conpool

+3 -6

README.md

···

       45
       45
        
       ```ocaml

     

       46
       46
        
       let run env =

     

       47
       47
        
         Switch.run (fun sw ->

     

       48
       48
       -
           (* Create TLS configuration *)

     

       49
       49
       -
           let tls = Conpool.Tls_config.make

     

       50
       50
       -
             ~authenticator:(Ca_certs.authenticator ())

     

       51
       51
       -
             ()

     

       52
       52
       -
           in

     

       48
       48
       +
           (* Create TLS configuration - SNI servername is automatically set to the endpoint's hostname *)

     

       49
       49
       +
           let tls_config = Tls.Config.client ~authenticator:(Ca_certs.authenticator ()) () in

     

       53
       50
        
       

     

       54
       51
        
           (* Create pool with TLS *)

     

       55
       52
        
           let pool = Conpool.create

     

       56
       53
        
             ~sw

     

       57
       54
        
             ~net:(Eio.Stdenv.net env)

     

       58
       55
        
             ~clock:(Eio.Stdenv.clock env)

     

       59
       59
       -
             ~tls

     

       56
       56
       +
             ~tls:tls_config

     

       60
       57
        
             ()

     

       61
       58
        
           in

     

       62
       59

+3 -3

lib/connection.ml

···

       23
       23
        
       let flow t = t.flow

     

       24
       24
        
       let endpoint t = t.endpoint

     

       25
       25
        
       let created_at t = t.created_at

     

       26
       26
       -
       let last_used t = Eio.Mutex.use_ro t.mutex (fun () -> t.last_used)

     

       27
       27
       -
       let use_count t = Eio.Mutex.use_ro t.mutex (fun () -> t.use_count)

     

       26
       26
       +
       let last_used t = t.last_used

     

       27
       27
       +
       let use_count t = t.use_count

     

       28
       28
        
       

     

       29
       29
        
       let update_usage t ~now =

     

       30
       30
        
         Eio.Mutex.use_rw ~protect:true t.mutex (fun () ->

     
···

       32
       32
        
             t.use_count <- t.use_count + 1)

     

       33
       33
        
       

     

       34
       34
        
       let pp ppf t =

     

       35
       35
       -
         let uses = Eio.Mutex.use_ro t.mutex (fun () -> t.use_count) in

     

       35
       35
       +
         let uses = t.use_count in

     

       36
       36
        
         Fmt.pf ppf "Connection(endpoint=%a, created_at=%.2f, uses=%d)" Endpoint.pp

     

       37
       37
        
           t.endpoint t.created_at uses

+4 -10

lib/conpool.ml

···

       11
       11
        
       

     

       12
       12
        
       (* Re-export submodules *)

     

       13
       13
        
       module Endpoint = Endpoint

     

       14
       14
       -
       module Tls_config = Tls_config

     

       15
       14
        
       module Config = Config

     

       16
       15
        
       module Stats = Stats

     

       17
       16
        
       module Cmd = Cmd

     
···

       80
       79
        
         net : 'net;

     

       81
       80
        
         clock : 'clock;

     

       82
       81
        
         config : Config.t;

     

       83
       83
       -
         tls : Tls_config.t option;

     

       82
       82
       +
         tls : Tls.Config.client option;

     

       84
       83
        
         endpoints : (Endpoint.t, endpoint_pool) Hashtbl.t;

     

       85
       84
        
         endpoints_mutex : Eio.Mutex.t;

     

       86
       85
        
       }

     
···

       170
       169
        
             match pool.tls with

     

       171
       170
        
             | None ->

     

       172
       171
        
                 (socket :> connection)

     

       173
       173
       -
             | Some tls_cfg ->

     

       172
       172
       +
             | Some tls_config ->

     

       174
       173
        
                 Log.debug (fun m ->

     

       175
       174
        
                     m "Initiating TLS handshake with %a" Endpoint.pp endpoint);

     

       176
       175
        
                 let host =

     

       177
       177
       -
                   match Tls_config.servername tls_cfg with

     

       178
       178
       -
                   | Some name -> Domain_name.(host_exn (of_string_exn name))

     

       179
       179
       -
                   | None ->

     

       180
       180
       -
                       Domain_name.(host_exn (of_string_exn (Endpoint.host endpoint)))

     

       176
       176
       +
                   Domain_name.(host_exn (of_string_exn (Endpoint.host endpoint)))

     

       181
       177
        
                 in

     

       182
       182
       -
                 let tls_flow =

     

       183
       183
       -
                   Tls_eio.client_of_flow ~host (Tls_config.config tls_cfg) socket

     

       184
       184
       -
                 in

     

       178
       178
       +
                 let tls_flow = Tls_eio.client_of_flow ~host tls_config socket in

     

       185
       179
        
                 Log.info (fun m ->

     

       186
       180
        
                     m "TLS connection established to %a" Endpoint.pp endpoint);

     

       187
       181
        
                 (tls_flow :> connection)

+4 -6

lib/conpool.mli

···

       16
       16
        
       

     

       17
       17
        
           Each submodule also exposes its own log source for fine-grained control:

     

       18
       18
        
           - {!Endpoint.src} - endpoint operations

     

       19
       19
       -
           - {!Tls_config.src} - TLS configuration

     

       20
       19
        
           - {!Config.src} - pool configuration *)

     

       21
       20
        
       

     

       22
       21
        
       (** {1 Core Types} *)

     

       23
       22
        
       

     

       24
       23
        
       module Endpoint = Endpoint

     

       25
       24
        
       (** Network endpoint representation *)

     

       26
       26
       -
       

     

       27
       27
       -
       module Tls_config = Tls_config

     

       28
       28
       -
       (** TLS configuration for connection pools *)

     

       29
       25
        
       

     

       30
       26
        
       module Config = Config

     

       31
       27
        
       (** Configuration for connection pools *)

     
···

       87
       83
        
         sw:Eio.Switch.t ->

     

       88
       84
        
         net:'net Eio.Net.t ->

     

       89
       85
        
         clock:'clock Eio.Time.clock ->

     

       90
       90
       -
         ?tls:Tls_config.t ->

     

       86
       86
       +
         ?tls:Tls.Config.client ->

     

       91
       87
        
         ?config:Config.t ->

     

       92
       88
        
         unit ->

     

       93
       89
        
         t

     
···

       97
       93
        
           @param sw Switch for resource management

     

       98
       94
        
           @param net Network interface for creating connections

     

       99
       95
        
           @param clock Clock for timeouts and time-based validation

     

       100
       100
       -
           @param tls Optional TLS configuration applied to all connections

     

       96
       96
       +
           @param tls

     

       97
       97
       +
             Optional TLS client configuration applied to all connections. SNI

     

       98
       98
       +
             servername is automatically set to the endpoint's hostname.

     

       101
       99
        
           @param config

     

       102
       100
        
             Optional pool configuration (uses Config.default if not provided) *)

     

       103
       101

-25

lib/tls_config.ml

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       3
       -
         SPDX-License-Identifier: ISC

     

       4
       4
       -
        ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** TLS configuration for connection pools *)

     

       7
       7
       -
       

     

       8
       8
       -
       let src = Logs.Src.create "conpool.tls" ~doc:"Connection pool TLS configuration"

     

       9
       9
       -
       

     

       10
       10
       -
       module Log = (val Logs.src_log src : Logs.LOG)

     

       11
       11
       -
       

     

       12
       12
       -
       type t = { config : Tls.Config.client; servername : string option }

     

       13
       13
       -
       

     

       14
       14
       -
       let make ~config ?servername () =

     

       15
       15
       -
         Log.debug (fun m ->

     

       16
       16
       -
             m "Creating TLS config with servername: %s"

     

       17
       17
       -
               (match servername with Some s -> s | None -> "<default>"));

     

       18
       18
       -
         { config; servername }

     

       19
       19
       -
       

     

       20
       20
       -
       let config t = t.config

     

       21
       21
       -
       let servername t = t.servername

     

       22
       22
       -
       

     

       23
       23
       -
       let pp ppf t =

     

       24
       24
       -
         Fmt.pf ppf "TLS(servername=%s)"

     

       25
       25
       -
           (match t.servername with Some s -> s | None -> "<default>")

-42

lib/tls_config.mli

···

       1
       1
       -
       (*---------------------------------------------------------------------------

     

       2
       2
       -
         Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.

     

       3
       3
       -
         SPDX-License-Identifier: ISC

     

       4
       4
       -
        ---------------------------------------------------------------------------*)

     

       5
       5
       -
       

     

       6
       6
       -
       (** TLS configuration for connection pools *)

     

       7
       7
       -
       

     

       8
       8
       -
       (** {1 Logging} *)

     

       9
       9
       -
       

     

       10
       10
       -
       val src : Logs.Src.t

     

       11
       11
       -
       (** Logs source for TLS configuration operations. Configure logging with:

     

       12
       12
       -
           {[

     

       13
       13
       -
             Logs.Src.set_level Conpool.Tls_config.src (Some Logs.Debug)

     

       14
       14
       -
           ]} *)

     

       15
       15
       -
       

     

       16
       16
       -
       (** {1 Type} *)

     

       17
       17
       -
       

     

       18
       18
       -
       type t

     

       19
       19
       -
       (** TLS configuration applied to all connections in a pool *)

     

       20
       20
       -
       

     

       21
       21
       -
       (** {1 Construction} *)

     

       22
       22
       -
       

     

       23
       23
       -
       val make : config:Tls.Config.client -> ?servername:string -> unit -> t

     

       24
       24
       -
       (** Create TLS configuration.

     

       25
       25
       -
       

     

       26
       26
       -
           @param config TLS client configuration for all connections

     

       27
       27
       -
           @param servername

     

       28
       28
       -
             Optional SNI server name override. If [None], uses the endpoint's hostname

     

       29
       29
       -
       *)

     

       30
       30
       -
       

     

       31
       31
       -
       (** {1 Accessors} *)

     

       32
       32
       -
       

     

       33
       33
       -
       val config : t -> Tls.Config.client

     

       34
       34
       -
       (** Get the TLS client configuration. *)

     

       35
       35
       -
       

     

       36
       36
       -
       val servername : t -> string option

     

       37
       37
       -
       (** Get the SNI server name override, if any. *)

     

       38
       38
       -
       

     

       39
       39
       -
       (** {1 Pretty-printing} *)

     

       40
       40
       -
       

     

       41
       41
       -
       val pp : t Fmt.t

     

       42
       42
       -
       (** Pretty-printer for TLS configuration. *)