[P2P] ACLs: cosmetics, renamings, comments

docs/whitedoc/p2p.rst

@@ -28,14 +28,14 @@ General operation
 I/O Scheduling
 ~~~~~~~~~~~~~~
 
-The P2P layer uses a scheduling mechanism in order to be able to control its
+The P2P layer uses a scheduling mechanism in order to control its
-bandwidth usage as well as implementing different policies (e.g. read/write
+bandwidth usage as well as implementing different policies
-quotas) to different peers. For now, each peer is granted a fair share of the
+(e.g. read/write quotas) to different peers. For now, each peer is
-global allocated bandwidth, but it is planned for the individual allocated
+granted a fair share of the global allocated bandwidth, but it is
-bandwidth to each peer to be a function of the peer's score. Each connection is
+planned for the individual allocated bandwidth to each peer to be a
-associated tp a read/write queues where data is copied at a rate of equivalent
+function of the peer's score. Each connection has a read (resp. write)
-to max_download_speed / num_connections (resp. max_upload_speed /
+queue where data is copied at a rate of ``max_download_speed /
-num_connections).
+num_connections`` (resp. ``max_upload_speed / num_connections``).
 
 
 Encryption
@@ -86,18 +86,19 @@ layer. It basically runs the ``accept(2)`` syscall and call
 that it is made aware of an incoming connection. From there, the pool
 will decide how this new connection must be handled.
 
-BlackLists, WhiteLists, GreyLists
+{Black, While, Grey}lists
---------------------------------
+~~~~~~~~~~~~~~~~~~~~~~~~~
 
-The welcome worker takes care of filtering all incoming connections using two
+The welcome worker takes care of filtering all incoming connections
-static lists of address provided by the admin (either via the ``tezos-admin``
+using two static lists of addresses provided either by ``tezos-admin``
-client or directly in the configuration file) and an automatic (grey)list
+or directly in the configuration file. Also, an automatic (grey) list
-handled automatically by the p2p layer. The node admin can block or whitelist
+is handled automatically by the p2p layer. The node admin can block or
-individual ip addresses, while the p2p layer can temporarly ban ip addresses and
+whitelist individual ip addresses, while the p2p layer can temporarily
-peer's identities that misbihaved. The delay to remove an ip address from
+ban ip addresses and peers who misbehaved. The delay to remove an ip
-the greylist table is defined by the varaible ``greylist_timeout``, while
+address from the greylist table is defined by the configuration
-identities are greylisted in a fixed size ring and periodically removed. The
+variable ``greylist_timeout``, while peers are greylisted in a
-node admin can also flush the greylist tables using the ``tezos-admin`` client.
+fixed-size ring buffer and periodically removed. The node admin can
+also flush greylist tables with the ``tezos-admin`` client.
 
 Maintenance worker
 ------------------
@@ -127,5 +128,5 @@ Given these bounds, the maintenance worker:
   peers until it reaches at least ``min_target`` connections (and never
   more than ``max_target`` connections).
 
-The maintenance worker is also in charge to periodically run the greylists
+The maintenance worker is also in charge to periodically run the
-GC functions to unban ip addresses from the greylist.
+greylists GC functions to unban ip addresses from the greylist.

src/lib_base/p2p_addr.ml

@@ -34,15 +34,15 @@ let pp ppf addr =
   | None ->
       Format.fprintf ppf "[%a]" Ipaddr.V6.pp_hum addr
 
-let of_string_exn str =
+let of_string_opt str =
-  match Ipaddr.of_string_exn str with
+  Option.map (Ipaddr.of_string str) ~f:begin function
-  | V4 addr -> Ipaddr.v6_of_v4 addr
+    | Ipaddr.V4 addr -> Ipaddr.v6_of_v4 addr
     | V6 addr -> addr
+  end
 
-let of_string str =
+let of_string_exn str =
-  try Ok (of_string_exn str) with
+  match of_string_opt str with
-  | Invalid_argument s -> Error s
+  | None -> Pervasives.failwith "P2p_addr.of_string"
-  | Failure s -> Error s
+  | Some t -> t
-  | _ -> Error "P2p_addr.of_string"
 
 let to_string saddr = Format.asprintf "%a" pp saddr

src/lib_base/p2p_addr.mli

@@ -14,7 +14,7 @@ val encoding : t Data_encoding.t
 
 val pp : Format.formatter -> t -> unit
 
-val of_string : string -> (t, string) result
+val of_string_opt : string -> t option
 val of_string_exn : string -> t
 
 val to_string : t -> string

src/lib_client_commands/client_p2p_commands.ml

@@ -15,7 +15,7 @@ let port_arg () =
   let open Clic in
   default_arg
     ~long:"port"
-    ~placeholder:"number"
+    ~placeholder:"IP port"
     ~doc:"peer-to-peer port of the node"
     ~default: "9732"
     (parameter
@@ -89,8 +89,7 @@ let commands () =
        @@ param ~name:"address" ~desc:"IPv4 or IPV6 address" addr_parameter
        @@ stop)
       (fun port address (cctxt : #Client_context.full) ->
-         P2p_services.connect cctxt ~timeout:10. (address,port) >>=? fun () ->
+         P2p_services.connect cctxt ~timeout:10. (address, port)
-         return ()
       );
 
     command ~group ~desc: "Remove an IP address from the blacklist and whitelist."
@@ -99,28 +98,25 @@ let commands () =
        @@ param ~name:"address" ~desc:"IPv4 or IPV6 address" addr_parameter
        @@ stop)
       (fun () address (cctxt : #Client_context.full) ->
-         P2p_services.Points.forget cctxt (address,0) >>=? fun () ->
+         P2p_services.Points.forget cctxt (address, 0)
-         return ()
       );
 
-    command ~group ~desc: "Add a IP address to the blacklist."
+    command ~group ~desc: "Add an IP address to the blacklist."
       no_options
       (prefixes [ "ban" ; "address" ]
        @@ param ~name:"address" ~desc:"IPv4 or IPV6 address" addr_parameter
        @@ stop)
       (fun () address (cctxt : #Client_context.full) ->
-         P2p_services.Points.ban cctxt (address,0) >>=? fun () ->
+         P2p_services.Points.ban cctxt (address, 0)
-         return ()
       );
 
-    command ~group ~desc: "Add a IP address to the whitelist."
+    command ~group ~desc: "Add an IP address to the whitelist."
       no_options
       (prefixes [ "trust" ; "address" ]
        @@ param ~name:"address" ~desc:"IPv4 or IPV6 address" addr_parameter
        @@ stop)
       (fun () address (cctxt : #Client_context.full) ->
-         P2p_services.Points.trust cctxt (address,0) >>=? fun () ->
+         P2p_services.Points.trust cctxt (address, 0)
-         return ()
       );
 
     command ~group ~desc: "Check if an IP address is banned."
@@ -129,10 +125,10 @@ let commands () =
        @@ param ~name:"address" ~desc:"IPv4 or IPV6 address" addr_parameter
        @@ stop)
       (fun () address (cctxt : #Client_context.full) ->
-         P2p_services.Points.is_banned cctxt (address,0) >>=? fun answer ->
+         P2p_services.Points.banned cctxt (address, 0) >>=? fun banned ->
          cctxt#message
            "The given ip address is %s"
-           (if answer then "banned" else "not banned") >>= fun () ->
+           (if banned then "banned" else "not banned") >>= fun () ->
          return ()
       );
 
@@ -142,8 +138,7 @@ let commands () =
        @@ P2p_peer.Id.param ~name:"peer" ~desc:"peer network identity"
        @@ stop)
       (fun () peer (cctxt : #Client_context.full) ->
-         P2p_services.Peers.forget cctxt peer >>=? fun () ->
+         P2p_services.Peers.forget cctxt peer
-         return ()
       );
 
     command ~group ~desc: "Add a peer ID to the blacklist."
@@ -152,8 +147,7 @@ let commands () =
        @@ P2p_peer.Id.param ~name:"peer" ~desc:"peer network identity"
        @@ stop)
       (fun () peer (cctxt : #Client_context.full) ->
-         P2p_services.Peers.ban cctxt peer >>=? fun () ->
+         P2p_services.Peers.ban cctxt peer
-         return ()
       );
 
     command ~group ~desc: "Add a peer ID to the whitelist."
@@ -162,8 +156,7 @@ let commands () =
        @@ P2p_peer.Id.param ~name:"peer" ~desc:"peer network identity"
        @@ stop)
       (fun () peer (cctxt : #Client_context.full) ->
-         P2p_services.Peers.trust cctxt peer >>=? fun () ->
+         P2p_services.Peers.trust cctxt peer
-         return ()
       );
 
     command ~group ~desc: "Check if a peer ID is banned."
@@ -172,18 +165,17 @@ let commands () =
        @@ P2p_peer.Id.param ~name:"peer" ~desc:"peer network identity"
        @@ stop)
       (fun () peer (cctxt : #Client_context.full) ->
-         P2p_services.Peers.is_banned cctxt peer >>=? fun answer ->
+         P2p_services.Peers.banned cctxt peer >>=? fun banned ->
          cctxt#message
            "The given peer ID is %s"
-           (if answer then "banned" else "not banned") >>= fun () ->
+           (if banned then "banned" else "not banned") >>= fun () ->
          return ()
       );
 
-    command ~group ~desc: "Clear all greylist tables."
+    command ~group ~desc: "Clear all ACLs."
       no_options
-      (prefixes [ "clear" ; "greylists" ] @@ stop)
+      (prefixes [ "clear" ; "acls" ] @@ stop)
       (fun () (cctxt : #Client_context.full) ->
-         P2p_services.Greylist.clear cctxt () >>=? fun () ->
+         P2p_services.ACL.clear cctxt ()
-         return ()
       );
 ]

src/lib_p2p/p2p.ml

@@ -134,7 +134,7 @@ let create_maintenance_worker limits pool =
       ~expected:limits.expected_connections
       ~max:limits.max_connections
   in
-  P2p_maintenance.run bounds ~greylist_timeout:limits.greylist_timeout pool
+  P2p_maintenance.run bounds pool
 
 let may_create_welcome_worker config limits pool =
   match config.listening_port with
@@ -446,15 +446,10 @@ let fold_connections net = net.fold_connections
 let iter_connections net = net.iter_connections
 let on_new_connection net = net.on_new_connection
 
-let temp_ban_peer net peer_id =
+let greylist_addr net addr =
-  match net.pool with
+  Option.iter net.pool ~f:(fun pool -> P2p_pool.greylist_addr pool addr)
-  |None -> ()
+let greylist_peer net peer_id =
-  |Some pool -> P2p_pool.temp_ban_peer pool peer_id
+  Option.iter net.pool ~f:(fun pool -> P2p_pool.greylist_peer pool peer_id)
-
-let temp_ban_addr net addr =
-  match net.pool with
-  |None -> ()
-  |Some pool -> P2p_pool.temp_ban_addr pool addr
 
 module Raw = struct
   type 'a t = 'a P2p_pool.Message.t =
@@ -546,12 +541,12 @@ let build_rpc_directory net =
   let dir =
     RPC_directory.register1 dir P2p_services.S.connect begin fun point () timeout ->
       match net.pool with
-      | None -> failwith "The node has disable the P2P layer."
+      | None -> failwith "The P2P layer is disabled."
       | Some pool ->
-          fail_unless
+          fail_when
-            (not(P2p_pool.Points.is_banned pool point))
+            (P2p_pool.Points.banned pool point)
             (P2p_errors.Point_banned point) >>=? fun () ->
-          ignore (P2p_pool.connect ~timeout pool point : _ tzresult Lwt.t) ;
+          P2p_pool.connect ~timeout pool point >>=? fun _conn ->
           return ()
     end in
 
@@ -675,13 +670,13 @@ let build_rpc_directory net =
       end in
 
   let dir =
-    RPC_directory.register1 dir P2p_services.Peers.S.is_banned
+    RPC_directory.register1 dir P2p_services.Peers.S.banned
       begin fun peer_id () () ->
         match net.pool with
         | None -> return false
         | Some pool ->
             if P2p_pool.Peers.get_trusted pool peer_id then return false
-            else return (P2p_pool.Peers.is_banned pool peer_id)
+            else return (P2p_pool.Peers.banned pool peer_id)
       end in
 
   (* Network : Point *)
@@ -768,7 +763,7 @@ let build_rpc_directory net =
       end in
 
   let dir =
-    RPC_directory.gen_register1 dir P2p_services.Points.S.is_banned
+    RPC_directory.gen_register1 dir P2p_services.Points.S.banned
       begin fun point () () ->
         match net.pool with
         | None -> RPC_answer.return false
@@ -776,18 +771,18 @@ let build_rpc_directory net =
             if P2p_pool.Points.get_trusted pool point then
               RPC_answer.return false
             else
-              RPC_answer.return (P2p_pool.Points.is_banned pool point)
+              RPC_answer.return (P2p_pool.Points.banned pool point)
       end in
 
   (* Network : Greylist *)
 
   let dir =
-    RPC_directory.register dir P2p_services.Greylist.S.clear
+    RPC_directory.register dir P2p_services.ACL.S.clear
       begin fun () () () ->
         match net.pool with
         | None -> return ()
         | Some pool ->
-            P2p_pool.greylist_clear pool ;
+            P2p_pool.acl_clear pool ;
             return ()
       end in
 

src/lib_p2p/p2p.mli

@@ -213,8 +213,8 @@ val on_new_connection :
 
 val build_rpc_directory : _ t -> unit RPC_directory.t
 
-val temp_ban_addr : ('msg, 'meta) net -> P2p_addr.t -> unit
+val greylist_addr : ('msg, 'meta) net -> P2p_addr.t -> unit
-val temp_ban_peer : ('msg, 'meta) net -> P2p_peer.Id.t -> unit
+val greylist_peer : ('msg, 'meta) net -> P2p_peer.Id.t -> unit
 
 (**/**)
 

src/lib_p2p/p2p_acl.ml

@@ -129,16 +129,14 @@ module IpTable = Hashtbl.Make(struct
     let equal x y = Ipaddr.V6.compare x y = 0
   end)
 
-type raw = {
+type t = {
   mutable greylist_ips : IpSet.t ;
   greylist_peers : PeerRing.t ;
   banned_ips : unit IpTable.t ;
   banned_peers : unit P2p_peer.Table.t ;
 }
 
-type t = raw ref
+let create size = {
-
-let create size = ref {
   greylist_ips = IpSet.empty;
   greylist_peers = PeerRing.create size;
   banned_ips = IpTable.create 53;
@@ -147,27 +145,26 @@ let create size = ref {
 
 (* check if an ip is banned. priority is for static blacklist, then
    in the greylist *)
-let is_banned_addr acl addr =
+let banned_addr acl addr =
-  (IpTable.mem !acl.banned_ips addr) ||
+  IpTable.mem acl.banned_ips addr ||
-  (IpSet.mem addr !acl.greylist_ips)
+  IpSet.mem addr acl.greylist_ips
 
 (* Check is the peer_id is in the banned ring. It might be possible that
    a peer ID that is not banned, but its ip address is. *)
-let is_banned_peer acl peer_id =
+let banned_peer acl peer_id =
-  (P2p_peer.Table.mem !acl.banned_peers peer_id) ||
+  P2p_peer.Table.mem acl.banned_peers peer_id ||
-  (PeerRing.mem !acl.greylist_peers peer_id)
+  PeerRing.mem acl.greylist_peers peer_id
 
-let greylist_clear acl =
+let clear acl =
-  !acl.greylist_ips <- IpSet.empty;
+  acl.greylist_ips <- IpSet.empty;
-  P2p_peer.Table.clear !acl.banned_peers;
+  P2p_peer.Table.clear acl.banned_peers;
-  IpTable.clear !acl.banned_ips;
+  IpTable.clear acl.banned_ips;
-  PeerRing.clear !acl.greylist_peers
+  PeerRing.clear acl.greylist_peers
 
 module IPGreylist = struct
 
-  (* Add the given ip address to the ip greylist *)
   let add acl addr =
-    !acl.greylist_ips <- IpSet.add addr (Time.now()) !acl.greylist_ips
+    acl.greylist_ips <- IpSet.add addr (Time.now ()) acl.greylist_ips
 
   let mem acl addr = IpSet.mem addr !acl.greylist_ips
 
@@ -176,7 +173,7 @@ module IPGreylist = struct
      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
+    acl.greylist_ips <- IpSet.gc acl.greylist_ips ~delay
 
   let encoding = Data_encoding.(list P2p_addr.encoding)
 
@@ -184,40 +181,37 @@ end
 
 module IPBlacklist = struct
 
-  (* Add the given ip address to the ip blacklist *)
   let add acl addr =
-    IpTable.add !acl.banned_ips addr ()
+    IpTable.add acl.banned_ips addr ()
 
-  (* Remove the given ip address to the ip blacklist *)
   let remove acl addr =
-    IpTable.remove !acl.banned_ips addr
+    IpTable.remove acl.banned_ips addr
 
   let mem acl addr =
-    IpTable.mem !acl.banned_ips addr
+    IpTable.mem acl.banned_ips addr
 
 end
 
 module PeerBlacklist = struct
 
   let add acl addr =
-    P2p_peer.Table.add !acl.banned_peers addr ()
+    P2p_peer.Table.add acl.banned_peers addr ()
 
   let remove acl addr =
-    P2p_peer.Table.remove !acl.banned_peers addr
+    P2p_peer.Table.remove acl.banned_peers addr
 
   let mem acl addr =
-    P2p_peer.Table.mem !acl.banned_peers addr
+    P2p_peer.Table.mem acl.banned_peers addr
 
 end
 
 module PeerGreylist = struct
 
-  (* Ban the given peer_id. It also add the given ip address to the blacklist. *)
   let add acl peer_id =
-    PeerRing.add !acl.greylist_peers peer_id
+    PeerRing.add acl.greylist_peers peer_id
 
   let mem acl peer_id =
-    (PeerRing.mem !acl.greylist_peers peer_id)
+    (PeerRing.mem acl.greylist_peers peer_id)
 
 end
 

src/lib_p2p/p2p_acl.mli

@@ -8,11 +8,11 @@
 (**************************************************************************)
 
 (**
-   This module implements four tables
+   This module implements four Access Control Lists:
-   - ip grey lists used to automatically ban a given ip addr
+   - ip greylist used to automatically ban a given ip address.
-   - peer_id greylist used to automatically ban a given peer_id
+   - peer_id greylist used to automatically ban a given peer_id.
-   - ip black lists used to manually ban a given ip addr
+   - ip blacklist used to manually ban a given ip addr.
-   - peers black list used to manually trust a given peer_id
+   - peers blacklist used to manually trust a given peer_id.
 
    IP greylists use a time based GC to periodically remove entries from
    the table, while peer_id grey lists are built using a ring structure,
@@ -21,31 +21,30 @@
 
 *)
 
-
 type t
 
-(** Create a new ACL of given size *)
+(** [create size] is a set of four ACLs (see above) with the peer_id
+    greylist being a ring buffer of size [size]. *)
 val create : int -> t
 
-(** Check if an address is banned either temporally or permanently *)
+(** [banned_addr t addr] is [true] if [addr] is blacklisted or
-val is_banned_addr : t -> P2p_addr.t -> bool
+    greylisted. *)
+val banned_addr : t -> P2p_addr.t -> bool
 
-(** Check if a peer is banned either temporally or permanently *)
+(** [banned_peer t peer_id] is [true] if peer with id [peer_id] is
-val is_banned_peer : t -> P2p_peer.Id.t -> bool
+    blacklisted or greylisted. *)
+val banned_peer : t -> P2p_peer.Id.t -> bool
 
-(** Reinitialize the Greylist tables *)
+(** [clear t] clears all four ACLs. *)
-val greylist_clear : t -> unit
+val clear : t -> unit
 
 module IPGreylist : sig
 
-  (* Add the given ip address to the ip greylist *)
+  (** [add t addr] adds [addr] to the address greylist. *)
   val add: t -> P2p_addr.t -> unit
 
-  (** [gc time] removes all banned peers older than the given time in seconds
+  (** [gc time] removes all banned peers older than the given time in
-      The GC operation works only on the address set. Peers are removed
+      seconds. *)
-      from the ring in a round-robin fashion. If a address is removed
-      by the GC from the greylist set, it could potentially
-      persist in the peers' blacklist set until more peers are banned. *)
   val gc: t -> delay:float -> unit
 
   val encoding: P2p_addr.t list Data_encoding.t
@@ -54,20 +53,14 @@ end
 
 module IPBlacklist : sig
 
-  (* Add the given ip address to the ip blacklist *)
   val add: t -> P2p_addr.t -> unit
-
-  (* Remove the given ip address to the ip blacklist *)
   val remove: t -> P2p_addr.t -> unit
 
 end
 
 module PeerBlacklist : sig
 
-  (* Add the given ip address to the ip blacklist *)
   val add: t -> P2p_peer.Id.t -> unit
-
-  (* Remove the given ip address to the ip blacklist *)
   val remove: t -> P2p_peer.Id.t -> unit
 
 end
@@ -75,7 +68,6 @@ end
 
 module PeerGreylist : sig
 
-  (* Ban the given peer_id. It also add the given ip address to the blacklist. *)
   val add: t -> P2p_peer.Id.t -> unit
 
 end

src/lib_p2p/p2p_maintenance.ml

@@ -20,7 +20,6 @@ type 'meta pool = Pool : ('msg, 'meta) P2p_pool.t -> 'meta pool
 
 type 'meta t = {
   canceler: Lwt_canceler.t ;
-  greylist_timeout: float;
   bounds: bounds ;
   pool: 'meta pool ;
   just_maintained: unit Lwt_condition.t ;
@@ -53,7 +52,7 @@ let connectable st start_time expected =
           match P2p_point_state.Info.last_miss pi with
           | Some last when Time.(start_time < last)
                         || P2p_point_state.Info.greylisted ~now pi -> ()
-          | _ when (P2p_pool.Points.is_banned pool point) -> ()
+          | _ when (P2p_pool.Points.banned pool point) -> ()
           | last ->
               Bounded_point_info.insert (last, point) acc
         end
@@ -95,7 +94,8 @@ let rec try_to_contact
 let rec maintain st =
   let Pool pool = st.pool in
   let n_connected = P2p_pool.active_connections pool in
-  P2p_pool.gc_greylist pool ~delay:st.greylist_timeout;
+  let pool_cfg = P2p_pool.config pool in
+  P2p_pool.gc_greylist pool ~delay:pool_cfg.greylist_timeout;
   if n_connected < st.bounds.min_threshold then
     too_few_connections st n_connected
   else if st.bounds.max_threshold < n_connected then
@@ -168,11 +168,10 @@ let rec worker_loop st =
   | Error [ Canceled ] -> Lwt.return_unit
   | Error _ -> Lwt.return_unit
 
-let run ~greylist_timeout bounds pool =
+let run bounds pool =
   let canceler = Lwt_canceler.create () in
   let st = {
     canceler ;
-    greylist_timeout ;
     bounds ;
     pool = Pool pool ;
     just_maintained = Lwt_condition.create () ;

src/lib_p2p/p2p_maintenance.mli

@@ -36,12 +36,9 @@ type bounds = {
 type 'meta t
 (** Type of a maintenance worker. *)
 
-val run:
+val run: bounds -> ('msg, 'meta) P2p_pool.t -> 'meta t
-  greylist_timeout:float ->
-  bounds -> ('msg, 'meta) P2p_pool.t -> 'meta t
 (** [run ~greylist_timeout bounds pool] is a maintenance worker for
-    [pool] with connection targets specified in [bounds] and greylist
+    [pool] with connection targets specified in [bounds]. *)
-    GC frequency [greylist_timeout]. *)
 
 val maintain: 'meta t -> unit Lwt.t
 (** [maintain t] gives a hint to maintenance worker [t] that

src/lib_p2p/p2p_pool.ml

@@ -286,8 +286,8 @@ let gc_points ({ config = { max_known_points } ; known_points } as pool) =
       log pool Gc_points
 
 let register_point pool ?trusted _source_peer_id (addr, port as point) =
-  match P2p_point.Table.find pool.known_points point with
+  match P2p_point.Table.find_opt pool.known_points point with
-  | exception Not_found ->
+  | None ->
       let point_info = P2p_point_state.Info.create ?trusted addr port in
       Option.iter pool.config.max_known_points ~f:begin fun (max, _) ->
         if P2p_point.Table.length pool.known_points >= max then gc_points pool
@@ -295,7 +295,7 @@ let register_point pool ?trusted _source_peer_id (addr, port as point) =
       P2p_point.Table.add pool.known_points point point_info ;
       log pool (New_point point) ;
       point_info
-  | point_info -> point_info
+  | Some point_info -> point_info
 
 let may_register_my_id_point pool = function
   | [P2p_errors.Myself (addr, Some port)] ->
@@ -424,22 +424,19 @@ module Points = struct
   type ('msg, 'meta) info = ('msg, 'meta) connection P2p_point_state.Info.t
 
   let info { known_points } point =
-    try Some (P2p_point.Table.find known_points point)
+    P2p_point.Table.find_opt known_points point
-    with Not_found -> None
 
   let get_trusted pool point =
-    try P2p_point_state.Info.trusted (P2p_point.Table.find pool.known_points point)
+    Option.unopt_map ~default:false ~f:P2p_point_state.Info.trusted
-    with Not_found -> false
+      (P2p_point.Table.find_opt pool.known_points point)
 
   let set_trusted pool point =
-    try
     P2p_point_state.Info.set_trusted
       (register_point pool pool.config.identity.peer_id point)
-    with Not_found -> ()
 
   let unset_trusted pool point =
-    try P2p_point_state.Info.unset_trusted (P2p_point.Table.find pool.known_points point)
+    Option.iter ~f:P2p_point_state.Info.unset_trusted
-    with Not_found -> ()
+      (P2p_point.Table.find_opt pool.known_points point)
 
   let fold_known pool ~init ~f =
     P2p_point.Table.fold f pool.known_points init
@@ -447,18 +444,18 @@ module Points = struct
   let fold_connected  pool ~init ~f =
     P2p_point.Table.fold f pool.connected_points init
 
-  let is_banned pool point =
+  let banned pool (addr, _port) =
-    P2p_acl.is_banned_addr pool.acl (fst point)
+    P2p_acl.banned_addr pool.acl addr
 
-  let ban pool point =
+  let ban pool (addr, _port) =
-    P2p_acl.IPBlacklist.add pool.acl (fst point)
+    P2p_acl.IPBlacklist.add pool.acl addr
 
-  let trust pool point =
+  let trust pool (addr, _port) =
-    P2p_acl.IPBlacklist.remove pool.acl (fst point)
+    P2p_acl.IPBlacklist.remove pool.acl addr
 
-  let forget pool point =
+  let forget pool ((addr, _port) as point) =
     unset_trusted pool point; (* remove from whitelist *)
-    P2p_acl.IPBlacklist.remove pool.acl (fst point)
+    P2p_acl.IPBlacklist.remove pool.acl addr
 
 end
 
@@ -499,28 +496,23 @@ module Peers = struct
     P2p_peer.Table.fold f pool.connected_peer_ids init
 
   let forget pool peer =
-    match get_addr pool peer with
+    Option.iter (get_addr pool peer) ~f:begin fun (addr, _port) ->
-    |None -> ()
-    |Some point ->
       unset_trusted pool peer; (* remove from whitelist *)
       P2p_acl.PeerBlacklist.remove pool.acl peer;
-        P2p_acl.IPBlacklist.remove pool.acl (fst point)
+      P2p_acl.IPBlacklist.remove pool.acl addr
+    end
 
   let ban pool peer =
-    match get_addr pool peer with
+    Option.iter (get_addr pool peer) ~f:begin fun point ->
-    |None -> ()
-    |Some point ->
       Points.ban pool point ;
       P2p_acl.PeerBlacklist.add pool.acl peer
+    end
 
   let trust pool peer =
-    match get_addr pool peer with
+    Option.iter (get_addr pool peer) ~f:(Points.trust pool)
-    |None -> ()
-    |Some point ->
-        Points.trust pool point
 
-  let is_banned pool peer =
+  let banned pool peer =
-    P2p_acl.is_banned_peer pool.acl peer
+    P2p_acl.banned_peer pool.acl peer
 
 end
 
@@ -592,24 +584,26 @@ module Connection = struct
 
 end
 
-let temp_ban_addr pool addr =
+let greylist_addr pool addr =
   P2p_acl.IPGreylist.add pool.acl addr
 
-let temp_ban_peer pool peer =
+let greylist_peer pool peer =
-  match get_addr pool peer with
+  Option.iter (get_addr pool peer) ~f:begin fun (addr, _port) ->
-  |None -> ()
+    P2p_acl.IPGreylist.add pool.acl addr ;
-  |Some point ->
-      temp_ban_addr pool (fst point);
     P2p_acl.PeerGreylist.add pool.acl peer
+  end
 
-let greylist_clear pool =
+let acl_clear pool =
-  P2p_acl.greylist_clear pool.acl
+  P2p_acl.clear pool.acl
 
-let gc_greylist ~delay pool = P2p_acl.IPGreylist.gc ~delay pool.acl
+let gc_greylist ~delay pool =
+  P2p_acl.IPGreylist.gc ~delay pool.acl
 
 let pool_stat { io_sched } =
   P2p_io_scheduler.global_stat io_sched
 
+let config { config } = config
+
 (***************************************************************************)
 
 let fail_unless_disconnected_point point_info =
@@ -645,8 +639,7 @@ let compare_known_point_info p1 p2 =
   | true, true -> compare_last_seen p2 p1
 
 let rec connect ?timeout pool point =
-  fail_unless
+  fail_when (Points.banned pool point)
-    (not(Points.is_banned pool point))
     (P2p_errors.Point_banned point) >>=? fun () ->
   let timeout =
     Option.unopt ~default:pool.config.connection_timeout timeout in
@@ -722,8 +715,7 @@ and authenticate pool ?point_info canceler fd point =
   lwt_debug "authenticate: %a -> auth %a"
     P2p_point.Id.pp point
     P2p_connection.Info.pp info >>= fun () ->
-  fail_unless
+  fail_when (Peers.banned pool info.peer_id)
-    (not(Peers.is_banned pool info.peer_id))
     (P2p_errors.Peer_banned info.peer_id) >>=? fun () ->
   let remote_point_info =
     match info.id_point with
@@ -983,7 +975,7 @@ let accept pool fd point =
   if pool.config.max_incoming_connections <= P2p_point.Table.length pool.incoming
   || pool.config.max_connections <= active_connections pool
   (* silently ignore banned points *)
-  || (P2p_acl.is_banned_addr pool.acl (fst point)) then
+  || (P2p_acl.banned_addr pool.acl (fst point)) then
     Lwt.async (fun () -> Lwt_utils_unix.safe_close fd)
   else
     let canceler = Lwt_canceler.create () in

src/lib_p2p/p2p_pool.mli

@@ -153,6 +153,10 @@ val pool_stat: ('msg, 'meta) pool -> P2p_stat.t
 (** [pool_stat pool] is a snapshot of current bandwidth usage for the
     entire [pool]. *)
 
+val config : _ pool -> config
+(** [config pool] is the [config] argument passed to [pool] at
+    creation. *)
+
 val send_swap_request: ('msg, 'meta) pool -> unit
 
 (** {2 Pool events} *)
@@ -270,10 +274,18 @@ val broadcast_bootstrap_msg:  ('msg, 'meta) pool -> unit
 (** [write_all pool msg] is [P2P_connection.write_now conn Bootstrap]
     for all member connections to [pool] in [Running] state. *)
 
-val temp_ban_peer : ('msg, 'meta) pool -> P2p_peer.Id.t -> unit
+val greylist_addr : ('msg, 'meta) pool -> P2p_addr.t -> unit
-val temp_ban_addr : ('msg, 'meta) pool -> P2p_addr.t -> unit
+(** [greylist_addr pool addr] adds [addr] to [pool]'s IP greylist. *)
+
+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
-val greylist_clear : ('msg, 'meta) pool -> unit
+(** [gc_greylist ~delay pool] *)
+
+val acl_clear : ('msg, 'meta) pool -> unit
+(** [acl_clear pool] clears ACL tables. *)
 
 (** {1 Functions on [Peer_id]} *)
 
@@ -307,7 +319,7 @@ module Peers : sig
   val forget : ('msg, 'meta) pool -> P2p_peer.Id.t -> unit
   val ban : ('msg, 'meta) pool -> P2p_peer.Id.t -> unit
   val trust : ('msg, 'meta) pool -> P2p_peer.Id.t -> unit
-  val is_banned : ('msg, 'meta) pool -> P2p_peer.Id.t -> bool
+  val banned : ('msg, 'meta) pool -> P2p_peer.Id.t -> bool
 
 end
 
@@ -339,7 +351,7 @@ module Points : sig
   val forget : ('msg, 'meta) pool -> P2p_point.Id.t -> unit
   val ban : ('msg, 'meta) pool -> P2p_point.Id.t -> unit
   val trust : ('msg, 'meta) pool -> P2p_point.Id.t -> unit
-  val is_banned : ('msg, 'meta) pool -> P2p_point.Id.t -> bool
+  val banned : ('msg, 'meta) pool -> P2p_point.Id.t -> bool
 
 end
 

src/lib_p2p/test/test_p2p_banned_peers.ml

@@ -25,7 +25,7 @@ let peers = [foo;bar;baz]
 let test_empty _ =
   let empty = P2p_acl.create 10 in
   List.iter (fun (_peer,addr) ->
-      assert_equal_bool ~msg:__LOC__ false (P2p_acl.is_banned_addr empty addr)
+      assert_equal_bool ~msg:__LOC__ false (P2p_acl.banned_addr empty addr)
     ) peers ;
   Lwt.return ()
 ;;
@@ -34,7 +34,7 @@ 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) ->
-      assert_equal_bool ~msg:__LOC__ true (P2p_acl.is_banned_addr set addr)
+      assert_equal_bool ~msg:__LOC__ true (P2p_acl.banned_addr set addr)
     ) peers ;
   Lwt.return ()
 ;;
@@ -43,13 +43,13 @@ let test_gc _ =
   let set = P2p_acl.create 10 in
   List.iter (fun (_,addr) -> P2p_acl.IPGreylist.add set addr) peers;
   List.iter (fun (_peer,addr) ->
-      assert_equal_bool ~msg:__LOC__ true (P2p_acl.is_banned_addr set 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. ;
   List.iter (fun (_peer,addr) ->
-      assert_equal_bool ~msg:__LOC__ false (P2p_acl.is_banned_addr set addr)
+      assert_equal_bool ~msg:__LOC__ false (P2p_acl.banned_addr set addr)
     ) peers ;
   Lwt.return ()
 

src/lib_shell/distributed_db.ml

@@ -487,7 +487,7 @@ module P2p_reader = struct
           chain_db.callback.notify_branch state.gid locator
         else
           (* Kickban *)
-          P2p.temp_ban_peer global_db.p2p state.gid;
+          P2p.greylist_peer global_db.p2p state.gid;
         Lwt.return_unit
 
     | Deactivate chain_id ->
@@ -513,7 +513,7 @@ module P2p_reader = struct
           chain_db.callback.notify_head state.gid header mempool
         else
           (* Kickban *)
-          P2p.temp_ban_peer global_db.p2p state.gid ;
+          P2p.greylist_peer global_db.p2p state.gid ;
         Lwt.return_unit
 
     | Get_block_headers hashes ->
@@ -768,8 +768,8 @@ let get_chain { active_chains } chain_id =
   try Some (Chain_id.Table.find active_chains chain_id)
   with Not_found -> None
 
-let temp_ban { global_db = { p2p } } peer_id =
+let greylist { global_db = { p2p } } peer_id =
-  Lwt.return (P2p.temp_ban_peer p2p peer_id)
+  Lwt.return (P2p.greylist_peer p2p peer_id)
 
 let disconnect { global_db = { p2p } } peer_id =
   match P2p.find_connection p2p peer_id with

src/lib_shell/distributed_db.mli

@@ -54,8 +54,8 @@ val set_callback: chain_db -> callback -> unit
 (** Kick a given peer. *)
 val disconnect: chain_db -> P2p_peer.Id.t -> unit Lwt.t
 
-(** Temporarily ban of a given peer. *)
+(** Greylist a given peer. *)
-val temp_ban: chain_db -> P2p_peer.Id.t -> unit Lwt.t
+val greylist: chain_db -> P2p_peer.Id.t -> unit Lwt.t
 
 (** Various accessors. *)
 val chain_state: chain_db -> State.Chain.t

src/lib_shell/peer_validator.ml

@@ -251,7 +251,7 @@ let on_error w r st errs =
     ((( Validation_errors.Unknown_ancestor
       | Validation_errors.Invalid_locator _
       | Block_validator_errors.Invalid_block _ ) :: _) as errors ) ->
-      Distributed_db.temp_ban pv.parameters.chain_db pv.peer_id >>= fun () ->
+      Distributed_db.greylist pv.parameters.chain_db pv.peer_id >>= fun () ->
       debug w
         "Terminating the validation worker for peer %a (kickban)."
         P2p_peer.Id.pp_short pv.peer_id ;

src/lib_shell_services/p2p_errors.ml

@@ -216,10 +216,10 @@ let () =
     ~id:"node.p2p_pool.point_banned"
     ~title:"Point Banned"
     ~description:"The addr you tried to connect is banned."
-    ~pp:(fun ppf point ->
+    ~pp:(fun ppf (addr, _port) ->
         Format.fprintf ppf
           "The addr you tried to connect (%a) is banned."
-          P2p_addr.pp (fst point))
+          P2p_addr.pp addr)
     Data_encoding.(obj1 (req "point" P2p_point.Id.encoding))
     (function Point_banned point -> Some point | _ -> None)
     (fun point -> Point_banned point) ;

src/lib_shell_services/p2p_services.ml

@@ -137,7 +137,7 @@ module Points = struct
         ~query: RPC_query.empty
         ~input: Data_encoding.empty
         ~output: Data_encoding.empty
-        ~description:"Ban the given address permanently."
+        ~description:"Blacklist the given address."
         RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "ban" )
 
     let trust =
@@ -147,16 +147,17 @@ module Points = struct
         ~output: Data_encoding.empty
         ~description:"Trust a given address permanently. \
                       Connections from this address can still be closed \
-                      on authentication if the peer is banned or blocked."
+                      on authentication if the peer is blacklisted or greylisted."
         RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "trust" )
 
-    let is_banned =
+    let banned =
       RPC_service.post_service
         ~query: RPC_query.empty
         ~input: Data_encoding.empty
         ~output: Data_encoding.bool
-        ~description:"Check is a given address is blocked, permanently or temporarily."
+        ~description:"Check is a given address is blacklisted or \
-        RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "isbanned" )
+                      greylisted."
+        RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "banned" )
 
   end
 
@@ -168,7 +169,7 @@ module Points = struct
   let forget ctxt peer_id = make_call1 S.forget ctxt peer_id () ()
   let ban ctxt peer_id = make_call1 S.ban ctxt peer_id () ()
   let trust ctxt peer_id = make_call1 S.trust ctxt peer_id () ()
-  let is_banned ctxt peer_id = make_call1 S.is_banned ctxt peer_id () ()
+  let banned ctxt peer_id = make_call1 S.banned ctxt peer_id () ()
 
 end
 
@@ -220,7 +221,7 @@ module Peers = struct
         ~query: RPC_query.empty
         ~input: Data_encoding.empty
         ~output: Data_encoding.empty
-        ~description:"Ban the given peer permanently."
+        ~description:"Blacklist the given peer."
         RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "ban" )
 
     let trust =
@@ -228,17 +229,18 @@ module Peers = struct
         ~query: RPC_query.empty
         ~input: Data_encoding.empty
         ~output: Data_encoding.empty
-        ~description:"Trust a given peer permanently: \
+        ~description:"Trust a given peer permanently: the peer cannot \
-                      the peer cannot be blocked (but its machine's IP still can)."
+                      be blocked (but its host IP still can)."
         RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "trust" )
 
-    let is_banned =
+    let banned =
       RPC_service.post_service
         ~query: RPC_query.empty
         ~input: Data_encoding.empty
         ~output: Data_encoding.bool
-        ~description:"Check is a given peer is blocked, permanently or temporarily."
+        ~description:"Check if a given peer is blacklisted or \
-        RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "isbanned" )
+                      greylisted."
+        RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "banned" )
 
   end
 
@@ -249,11 +251,11 @@ module Peers = struct
   let forget ctxt point_id = make_call1 S.forget ctxt point_id () ()
   let ban ctxt point_id = make_call1 S.ban ctxt point_id () ()
   let trust ctxt point_id = make_call1 S.trust ctxt point_id () ()
-  let is_banned ctxt point_id = make_call1 S.is_banned ctxt point_id () ()
+  let banned ctxt point_id = make_call1 S.banned ctxt point_id () ()
 
 end
 
-module Greylist = struct
+module ACL = struct
 
   module S = struct
 

src/lib_shell_services/p2p_services.mli

@@ -93,7 +93,7 @@ module Points : sig
 
   val trust: #simple -> P2p_point.Id.t -> unit tzresult Lwt.t
 
-  val is_banned: #simple -> P2p_point.Id.t -> bool tzresult Lwt.t
+  val banned: #simple -> P2p_point.Id.t -> bool tzresult Lwt.t
 
   module S : sig
 
@@ -127,7 +127,7 @@ module Points : sig
        unit * P2p_point.Id.t, unit, unit,
        unit) RPC_service.t
 
-    val is_banned :
+    val banned :
       ([ `POST ], unit,
        unit * P2p_point.Id.t, unit, unit,
        bool) RPC_service.t
@@ -157,7 +157,7 @@ module Peers : sig
 
   val trust: #simple -> P2p_peer.Id.t -> unit tzresult Lwt.t
 
-  val is_banned: #simple -> P2p_peer.Id.t -> bool tzresult Lwt.t
+  val banned: #simple -> P2p_peer.Id.t -> bool tzresult Lwt.t
 
   module S : sig
 
@@ -191,7 +191,7 @@ module Peers : sig
        unit * P2p_peer.Id.t, unit, unit,
        unit) RPC_service.t
 
-    val is_banned :
+    val banned :
       ([ `POST ], unit,
        unit * P2p_peer.Id.t, unit, unit,
        bool) RPC_service.t
@@ -200,7 +200,7 @@ module Peers : sig
 
 end
 
-module Greylist : sig
+module ACL : sig
 
   val clear: #simple -> unit -> unit tzresult Lwt.t