From 7b76fe80150d9759b4ab6497104b1a550a856966 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Wed, 27 Oct 2021 16:17:51 +0200 Subject: [PATCH 1/2] happy-eyeballs: timer always returns an 'action list' happy-eyeballs-lwt/happy-eyeballs-mirage: adapt to the API change --- lwt/happy_eyeballs_lwt.ml | 8 ++++---- mirage/happy_eyeballs_mirage.ml | 8 ++++---- src/happy_eyeballs.ml | 6 ++---- src/happy_eyeballs.mli | 9 +++++---- 4 files changed, 15 insertions(+), 16 deletions(-) diff --git a/lwt/happy_eyeballs_lwt.ml b/lwt/happy_eyeballs_lwt.ml index 7003a16..4b90baf 100644 --- a/lwt/happy_eyeballs_lwt.ml +++ b/lwt/happy_eyeballs_lwt.ml @@ -104,13 +104,13 @@ let handle_timer_actions t actions = let rec timer t = let open Lwt.Infix in let rec loop () = - let he, actions = Happy_eyeballs.timer t.he (now ()) in + let he, cont, actions = Happy_eyeballs.timer t.he (now ()) in t.he <- he ; - match actions with + handle_timer_actions t actions ; + match cont with | `Suspend -> timer t - | `Act actions -> - handle_timer_actions t actions ; + | `Act -> Lwt_unix.sleep t.timer_interval >>= fun () -> loop () in diff --git a/mirage/happy_eyeballs_mirage.ml b/mirage/happy_eyeballs_mirage.ml index 7c7acf3..1b18c85 100644 --- a/mirage/happy_eyeballs_mirage.ml +++ b/mirage/happy_eyeballs_mirage.ml @@ -88,13 +88,13 @@ module Make (R : Mirage_random.S) (T : Mirage_time.S) (C : Mirage_clock.MCLOCK) let rec timer t = let open Lwt.Infix in let rec loop () = - let he, actions = Happy_eyeballs.timer t.he (C.elapsed_ns ()) in + let he, cont, actions = Happy_eyeballs.timer t.he (C.elapsed_ns ()) in t.he <- he ; - match actions with + handle_timer_actions t actions ; + match cont with | `Suspend -> timer t - | `Act actions -> - handle_timer_actions t actions ; + | `Act -> T.sleep_ns t.timer_interval >>= fun () -> loop () in diff --git a/src/happy_eyeballs.ml b/src/happy_eyeballs.ml index 0ede0f1..61907e1 100644 --- a/src/happy_eyeballs.ml +++ b/src/happy_eyeballs.ml @@ -181,10 +181,8 @@ let timer t now = in Log.debug (fun m -> m "timer %d actions" (List.length actions)); { t with conns }, - if Domain_name.Host_map.is_empty conns then - (assert (actions = []); `Suspend) - else - `Act actions + (if Domain_name.Host_map.is_empty conns then `Suspend else `Act), + actions let connect t now ~id host ports = if ports = [] then failwith "empty port list not supported"; diff --git a/src/happy_eyeballs.mli b/src/happy_eyeballs.mli index fda3cf9..1ffa9b8 100644 --- a/src/happy_eyeballs.mli +++ b/src/happy_eyeballs.mli @@ -32,11 +32,12 @@ val create : ?aaaa_timeout:int64 -> ?connect_timeout:int64 -> [connect_timeout] and [resolve_timeout] use a default of [Duration.of_sec 1]. *) -val timer : t -> int64 -> t * [ `Suspend | `Act of action list ] +val timer : t -> int64 -> t * [ `Suspend | `Act ] * action list (** [timer t ts] is a timer function that results in an updated [t] and either - [`Suspend] signalling the timer thread can sleep or [`Act actions] a list - of actions that need to be performed (connection to be retried, connection - failures to be reported, ...). + [`Suspend] signalling the timer thread can sleep or [`Act] that the timer + should be called again. In addition, a list of actions that need to be + performed (connection to be retried, connection failures to be reported, + ...) is provided. The timer thread should be signalled to resume after calling [connect] or [connect_ip]. *) From 66f7d981a02efd5a7ff0f27f124257e632eeb322 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Wed, 27 Oct 2021 16:36:20 +0200 Subject: [PATCH 2/2] support OCaml 4.08 (requested in #16) --- happy-eyeballs-lwt.opam | 2 +- happy-eyeballs-mirage.opam | 2 +- happy-eyeballs.opam | 2 +- src/happy_eyeballs.ml | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/happy-eyeballs-lwt.opam b/happy-eyeballs-lwt.opam index d23126d..45aca3d 100644 --- a/happy-eyeballs-lwt.opam +++ b/happy-eyeballs-lwt.opam @@ -8,7 +8,7 @@ doc: "https://roburio.github.io/happy-eyeballs/" license: "ISC" depends: [ - "ocaml" {>= "4.10.0"} + "ocaml" {>= "4.08.0"} "dune" {>= "2.0.0"} "happy-eyeballs" {=version} "cmdliner" diff --git a/happy-eyeballs-mirage.opam b/happy-eyeballs-mirage.opam index 2739f4f..edf5893 100644 --- a/happy-eyeballs-mirage.opam +++ b/happy-eyeballs-mirage.opam @@ -8,7 +8,7 @@ doc: "https://roburio.github.io/happy-eyeballs/" license: "ISC" depends: [ - "ocaml" {>= "4.10.0"} + "ocaml" {>= "4.08.0"} "dune" {>= "2.0.0"} "happy-eyeballs" {=version} "duration" diff --git a/happy-eyeballs.opam b/happy-eyeballs.opam index a23dd85..e6dcbe1 100644 --- a/happy-eyeballs.opam +++ b/happy-eyeballs.opam @@ -8,7 +8,7 @@ doc: "https://roburio.github.io/happy-eyeballs/" license: "ISC" depends: [ - "ocaml" {>= "4.10.0"} + "ocaml" {>= "4.08.0"} "dune" {>= "2.0.0"} "duration" "domain-name" {>= "0.2.0"} diff --git a/src/happy_eyeballs.ml b/src/happy_eyeballs.ml index 61907e1..d8a6cb1 100644 --- a/src/happy_eyeballs.ml +++ b/src/happy_eyeballs.ml @@ -137,7 +137,7 @@ let add_conn host id conn c = c let expand_list ips ports = - List.concat_map (fun ip -> List.map (fun p -> (ip, p)) ports) ips + List.flatten (List.map (fun ip -> List.map (fun p -> (ip, p)) ports) ips) (* all input has been verified that ips and ports are non-empty. *) let expand_list_split ips ports =