P2p_maintenance: improve 'try_to_contact' and 'connectable'

To avoid eventual infinite loops in 'try_to_contact', we
accumulate the set of points that have been seen to discard them
during recursive calls.
This commit is contained in:
OCamlPro-Iguernlala 2018-05-15 18:44:16 +02:00 committed by Grégoire Henry
parent 7eabd8e151
commit 4caf7cf679

View File

@ -32,7 +32,7 @@ type 'meta t = {
failed after [start_time] and the pointes that are banned. It failed after [start_time] and the pointes that are banned. It
first selects points with the oldest last tentative. first selects points with the oldest last tentative.
Non-trusted points are also ignored if option --closed is set. *) Non-trusted points are also ignored if option --closed is set. *)
let connectable st start_time expected = let connectable st start_time expected seen_points =
let Pool pool = st.pool in let Pool pool = st.pool in
let now = Time.now () in let now = Time.now () in
let module Bounded_point_info = let module Bounded_point_info =
@ -47,37 +47,49 @@ let connectable st start_time expected =
end) in end) in
let acc = Bounded_point_info.create expected in let acc = Bounded_point_info.create expected in
let closed = (P2p_pool.config pool).P2p_pool.closed_network in let closed = (P2p_pool.config pool).P2p_pool.closed_network in
P2p_pool.Points.fold_known pool ~init:() let seen_points =
~f:begin fun point pi () -> P2p_pool.Points.fold_known pool ~init:seen_points
(* consider the point only if --closed is not set, or if pi is ~f:begin fun point pi seen_points ->
trusted *) (* consider the point only if:
if not closed || P2p_point_state.Info.trusted pi then - it is not in seen_points and
match P2p_point_state.get pi with - it is not banned, and
| Disconnected -> begin - it is trusted if we are in `closed` mode
match P2p_point_state.Info.last_miss pi with *)
| Some last when Time.(start_time < last) if P2p_point.Set.mem point seen_points ||
|| P2p_point_state.Info.greylisted ~now pi -> () P2p_pool.Points.banned pool point ||
| _ when (P2p_pool.Points.banned pool point) -> () (closed && not (P2p_point_state.Info.trusted pi))
| last -> then
Bounded_point_info.insert (last, point) acc seen_points
end else
| _ -> () let seen_points = P2p_point.Set.add point seen_points in
end ; match P2p_point_state.get pi with
List.map snd (Bounded_point_info.get acc) | Disconnected -> begin
match P2p_point_state.Info.last_miss pi with
| Some last when Time.(start_time < last)
|| P2p_point_state.Info.greylisted ~now pi ->
seen_points
| last ->
Bounded_point_info.insert (last, point) acc ;
seen_points
end
| _ -> seen_points
end
in
List.map snd (Bounded_point_info.get acc), seen_points
(** Try to create connections to new peers. It tries to create at (** Try to create connections to new peers. It tries to create at
least [min_to_contact] connections, and will never creates more least [min_to_contact] connections, and will never creates more
than [max_to_contact]. But, if after trying once all disconnected than [max_to_contact]. But, if after trying once all disconnected
peers, it returns [false]. *) peers, it returns [false]. *)
let rec try_to_contact let rec try_to_contact
st ?(start_time = Time.now ()) st ?(start_time = Time.now ()) ~seen_points
min_to_contact max_to_contact = min_to_contact max_to_contact =
let Pool pool = st.pool in let Pool pool = st.pool in
if min_to_contact <= 0 then if min_to_contact <= 0 then
Lwt.return_true Lwt.return_true
else else
let contactable = let contactable, seen_points =
connectable st start_time max_to_contact in connectable st start_time max_to_contact seen_points in
if contactable = [] then if contactable = [] then
Lwt_unix.yield () >>= fun () -> Lwt_unix.yield () >>= fun () ->
Lwt.return_false Lwt.return_false
@ -89,7 +101,7 @@ let rec try_to_contact
| Error _ -> acc) | Error _ -> acc)
(Lwt.return 0) (Lwt.return 0)
contactable >>= fun established -> contactable >>= fun established ->
try_to_contact st ~start_time try_to_contact st ~start_time ~seen_points
(min_to_contact - established) (max_to_contact - established) (min_to_contact - established) (max_to_contact - established)
(** Do a maintenance step. It will terminate only when the number (** Do a maintenance step. It will terminate only when the number
@ -121,7 +133,9 @@ and too_few_connections st n_connected =
lwt_log_notice "Too few connections (%d)" n_connected >>= fun () -> lwt_log_notice "Too few connections (%d)" n_connected >>= fun () ->
let min_to_contact = st.bounds.min_target - n_connected in let min_to_contact = st.bounds.min_target - n_connected in
let max_to_contact = st.bounds.max_target - n_connected in let max_to_contact = st.bounds.max_target - n_connected in
try_to_contact st min_to_contact max_to_contact >>= fun success -> try_to_contact
st min_to_contact max_to_contact ~seen_points:P2p_point.Set.empty >>=
fun success ->
if success then begin if success then begin
maintain st maintain st
end else begin end else begin