Remove uses of Time.now in P2p_acl

src/bin_node/node_config_file.ml

@@ -62,7 +62,7 @@ and shell = {
 let default_p2p_limits : P2p.limits = {
   connection_timeout = 10. ;
   authentication_timeout = 5. ;
-  greylist_timeout = 86400. ; (* one day *)
+  greylist_timeout = 86400 ; (* one day *)
   min_connections = 10 ;
   expected_connections = 50 ;
   max_connections = 100 ;
@@ -278,7 +278,7 @@ let limit : P2p.limits Data_encoding.t =
           (dft "greylist-timeout"
              (Data_encoding.describe
                 ~description: "GC delay for the greylists tables, in seconds."
-                float) default_p2p_limits.greylist_timeout)
+                int31) default_p2p_limits.greylist_timeout)
 
        ))
 

src/lib_p2p/p2p.ml

@@ -43,7 +43,7 @@ type limits = {
 
   connection_timeout : float ;
   authentication_timeout : float ;
-  greylist_timeout : float ;
+  greylist_timeout : int ;
 
   min_connections : int ;
   expected_connections : int ;

src/lib_p2p/p2p.mli

@@ -54,7 +54,7 @@ type config = {
 
   closed_network : bool ;
   (** If [true], the only accepted connections are from peers whose
-      addresses are in [trusted_peers]. *)
+      addresses are in [trusted_points]. *)
 
   identity : P2p_identity.t ;
   (** Cryptographic identity of the peer. *)
@@ -73,7 +73,7 @@ type limits = {
   authentication_timeout : float ;
   (** Delay granted to a peer to perform authentication, in seconds. *)
 
-  greylist_timeout : float ;
+  greylist_timeout : int ;
   (** GC delay for the grelists tables, in seconds. *)
 
   min_connections : int ;

src/lib_p2p/p2p_acl.ml

@@ -105,19 +105,18 @@ module IpSet = struct
 
   include PatriciaTree(Time)
 
-  let gc t ~delay =
-    let timenow = Time.now() in
+  let remove_old t ~older_than =
     let module MI =
     struct
       type result = Time.t
-      let default = Time.now()
+      let default = Time.max_value
       let map _t _key value = value
       let reduce _t left right = Time.(min left right)
     end
     in
     let module MR = M.Map_Reduce(MI) in
     MR.filter (fun addtime ->
-        Time.(timenow < (add addtime (Int64.of_float delay)))
+        Time.(older_than <= addtime)
       ) t
 
 end
@@ -162,8 +161,8 @@ let clear acl =
 
 module IPGreylist = struct
 
-  let add acl addr =
-    acl.greylist_ips <- IpSet.add addr (Time.now ()) acl.greylist_ips
+  let add acl addr time =
+    acl.greylist_ips <- IpSet.add addr time acl.greylist_ips
 
   let mem acl addr = IpSet.mem addr !acl.greylist_ips
 
@@ -171,8 +170,8 @@ module IPGreylist = struct
      from the ring in a round-robin fashion. If a address is removed
      by the GC from the acl.greylist set, it could potentially
      persist in the acl.peers set until more peers are banned. *)
-  let gc acl ~delay =
-    acl.greylist_ips <- IpSet.gc acl.greylist_ips ~delay
+  let remove_old acl ~older_than =
+    acl.greylist_ips <- IpSet.remove_old acl.greylist_ips ~older_than
 
   let encoding = Data_encoding.(list P2p_addr.encoding)
 

src/lib_p2p/p2p_acl.mli

@@ -43,11 +43,11 @@ val clear : t -> unit
 module IPGreylist : sig
 
   (** [add t addr] adds [addr] to the address greylist. *)
-  val add: t -> P2p_addr.t -> unit
+  val add: t -> P2p_addr.t -> Time.t -> unit
 
-  (** [gc time] removes all banned peers older than the given time in
-      seconds. *)
-  val gc: t -> delay:float -> unit
+  (** [remove_old t ~older_than] removes all banned peers older than the
+      given time. *)
+  val remove_old: t -> older_than:Time.t -> unit
 
   val encoding: P2p_addr.t list Data_encoding.t
 
@@ -88,7 +88,7 @@ module IpSet : sig
   val mem : Ipaddr.V6.t -> t -> bool
   val fold: (Ipaddr.V6.Prefix.t -> Time.t -> 'a -> 'a) -> t -> 'a -> 'a
   val pp : Format.formatter -> t -> unit
-  val gc : t -> delay:float -> t
+  val remove_old : t -> older_than:Time.t -> t
 end
 
 module IpTable : Hashtbl.S with type key = Ipaddr.V6.t

src/lib_p2p/p2p_maintenance.ml

@@ -95,7 +95,10 @@ let rec maintain st =
   let Pool pool = st.pool in
   let n_connected = P2p_pool.active_connections pool in
   let pool_cfg = P2p_pool.config pool in
-  P2p_pool.gc_greylist pool ~delay:pool_cfg.greylist_timeout;
+  let older_than =
+    Time.(add (now ()) (Int64.of_int (- pool_cfg.greylist_timeout)))
+  in
+  P2p_pool.gc_greylist pool ~older_than;
   if n_connected < st.bounds.min_threshold then
     too_few_connections st n_connected
   else if st.bounds.max_threshold < n_connected then

src/lib_p2p/p2p_pool.ml

@@ -176,7 +176,7 @@ type config = {
   max_incoming_connections : int ;
   connection_timeout : float ;
   authentication_timeout : float ;
-  greylist_timeout : float ;
+  greylist_timeout : int ;
 
   incoming_app_message_queue_size : int option ;
   incoming_message_queue_size : int option ;
@@ -585,19 +585,19 @@ module Connection = struct
 end
 
 let greylist_addr pool addr =
-  P2p_acl.IPGreylist.add pool.acl addr
+  P2p_acl.IPGreylist.add pool.acl addr (Time.now ())
 
 let greylist_peer pool peer =
   Option.iter (get_addr pool peer) ~f:begin fun (addr, _port) ->
-    P2p_acl.IPGreylist.add pool.acl addr ;
+    greylist_addr pool addr ;
     P2p_acl.PeerGreylist.add pool.acl peer
   end
 
 let acl_clear pool =
   P2p_acl.clear pool.acl
 
-let gc_greylist ~delay pool =
-  P2p_acl.IPGreylist.gc ~delay pool.acl
+let gc_greylist ~older_than pool =
+  P2p_acl.IPGreylist.remove_old ~older_than pool.acl
 
 let pool_stat { io_sched } =
   P2p_io_scheduler.global_stat io_sched

src/lib_p2p/p2p_pool.mli

@@ -81,7 +81,7 @@ type config = {
   authentication_timeout : float ;
   (** Delay granted to a peer to perform authentication, in seconds. *)
 
-  greylist_timeout : float ;
+  greylist_timeout : int ;
   (** GC delay for the grelists tables, in seconds. *)
 
   incoming_app_message_queue_size : int option ;
@@ -281,8 +281,8 @@ val greylist_peer : ('msg, 'meta) pool -> P2p_peer.Id.t -> unit
 (** [greylist_peer pool peer] adds [peer] to [pool]'s peer greylist
     and [peer]'s address to [pool]'s IP greylist. *)
 
-val gc_greylist: delay:float -> ('msg, 'meta) pool -> unit
-(** [gc_greylist ~delay pool] *)
+val gc_greylist: older_than:Time.t -> ('msg, 'meta) pool -> unit
+(** [gc_greylist ~older_than pool] *)
 
 val acl_clear : ('msg, 'meta) pool -> unit
 (** [acl_clear pool] clears ACL tables. *)

src/lib_p2p/test/test_p2p_banned_peers.ml

@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Error_monad
-
 include Logging.Make (struct let name = "test-p2p-banned_peers" end)
 
 let assert_equal_bool ~msg a b =
@@ -32,7 +30,7 @@ let test_empty _ =
 
 let test_ban _ =
   let set = P2p_acl.create 10 in
-  List.iter (fun (_,addr) -> P2p_acl.IPGreylist.add set addr) peers;
+  List.iter (fun (_,addr) -> P2p_acl.IPGreylist.add set addr Time.epoch) peers;
   List.iter (fun (_,addr) ->
       assert_equal_bool ~msg:__LOC__ true (P2p_acl.banned_addr set addr)
     ) peers ;
@@ -41,13 +39,12 @@ let test_ban _ =
 
 let test_gc _ =
   let set = P2p_acl.create 10 in
-  List.iter (fun (_,addr) -> P2p_acl.IPGreylist.add set addr) peers;
+  List.iter (fun (_,addr) -> P2p_acl.IPGreylist.add set addr Time.epoch) peers;
   List.iter (fun (_peer,addr) ->
       assert_equal_bool ~msg:__LOC__ true (P2p_acl.banned_addr set addr)
     ) peers ;
-  Lwt_unix.sleep 3. >>= fun _ ->
-  (* remove all peers after one second *)
-  P2p_acl.IPGreylist.gc set ~delay:1. ;
+  (* remove all peers *)
+  P2p_acl.IPGreylist.remove_old set ~older_than:Time.max_value ;
   List.iter (fun (_peer,addr) ->
       assert_equal_bool ~msg:__LOC__ false (P2p_acl.banned_addr set addr)
     ) peers ;

src/lib_p2p/test/test_p2p_pool.ml

@@ -71,7 +71,7 @@ let detach_node f points n =
       max_incoming_connections = nb_points ;
       connection_timeout = 10. ;
       authentication_timeout = 2. ;
-      greylist_timeout = 2. ;
+      greylist_timeout = 2 ;
       incoming_app_message_queue_size = None ;
       incoming_message_queue_size = None ;
       outgoing_message_queue_size = None ;