Admin/P2P: remove forget peer/address RPC, introduce untrust & unban peer/address.

src/lib_p2p/p2p.ml

@@ -711,34 +711,44 @@ let build_rpc_directory net =
                   RPC_answer.return_stream { next ; shutdown }
       end in
 
-  let dir =
-    RPC_directory.gen_register1 dir P2p_services.Peers.S.forget
-      begin fun peer_id () () ->
-        match net.pool with
-        | None -> RPC_answer.not_found
-        | Some pool ->
-            P2p_pool.Peers.forget pool peer_id ;
-            RPC_answer.return_unit
-      end in
-
   let dir =
     RPC_directory.gen_register1 dir P2p_services.Peers.S.ban
       begin fun peer_id () () ->
         match net.pool with
         | None -> RPC_answer.not_found
         | Some pool ->
-            P2p_pool.Peers.unset_trusted pool peer_id;
+            P2p_pool.Peers.untrust pool peer_id ;
             P2p_pool.Peers.ban pool peer_id ;
             RPC_answer.return_unit
       end in
 
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Peers.S.unban
+      begin fun peer_id () () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool ->
+            P2p_pool.Peers.unban pool peer_id ;
+            RPC_answer.return_unit
+      end in
+
   let dir =
     RPC_directory.gen_register1 dir P2p_services.Peers.S.trust
       begin fun peer_id () () ->
         match net.pool with
         | None -> RPC_answer.not_found
         | Some pool ->
-            P2p_pool.Peers.set_trusted pool peer_id ;
+            P2p_pool.Peers.trust pool peer_id ;
+            RPC_answer.return_unit
+      end in
+
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Peers.S.untrust
+      begin fun peer_id () () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool ->
+            P2p_pool.Peers.untrust pool peer_id ;
             RPC_answer.return_unit
       end in
 
@@ -816,34 +826,44 @@ let build_rpc_directory net =
                   RPC_answer.return_stream { next ; shutdown }
       end in
 
-  let dir =
-    RPC_directory.gen_register1 dir P2p_services.Points.S.forget
-      begin fun point () () ->
-        match net.pool with
-        | None -> RPC_answer.not_found
-        | Some pool ->
-            P2p_pool.Points.forget pool point ;
-            RPC_answer.return_unit
-      end in
-
   let dir =
     RPC_directory.gen_register1 dir P2p_services.Points.S.ban
       begin fun point () () ->
         match net.pool with
         | None -> RPC_answer.not_found
         | Some pool ->
-            P2p_pool.Points.unset_trusted pool point;
+            P2p_pool.Points.untrust pool point;
             P2p_pool.Points.ban pool point;
             RPC_answer.return_unit
       end in
 
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Points.S.unban
+      begin fun point () () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool ->
+            P2p_pool.Points.unban pool point;
+            RPC_answer.return_unit
+      end in
+
   let dir =
     RPC_directory.gen_register1 dir P2p_services.Points.S.trust
       begin fun point () () ->
         match net.pool with
         | None -> RPC_answer.not_found
         | Some pool ->
-            P2p_pool.Points.set_trusted pool point ;
+            P2p_pool.Points.trust pool point ;
+            RPC_answer.return_unit
+      end in
+
+  let dir =
+    RPC_directory.gen_register1 dir P2p_services.Points.S.untrust
+      begin fun point () () ->
+        match net.pool with
+        | None -> RPC_answer.not_found
+        | Some pool ->
+            P2p_pool.Points.untrust pool point ;
             RPC_answer.return_unit
       end in
 

src/lib_p2p/p2p_pool.ml

@@ -450,6 +450,18 @@ let connection_of_peer_id pool peer_id =
     | _ -> None
   end
 
+(* Every running connection matching the point's ip address is returned. *)
+let connections_of_addr pool addr =
+  P2p_point.Table.fold
+    (fun (addr', _) p acc ->
+       if Ipaddr.V6.compare addr addr' = 0
+       then
+         match P2p_point_state.get p with
+         | P2p_point_state.Running { data } -> data :: acc
+         | _ -> acc
+       else acc
+    ) pool.connected_points []
+
 let get_addr pool peer_id =
   Option.map (connection_of_peer_id pool peer_id) ~f:begin fun ci ->
     (P2p_socket.info ci.conn).id_point
@@ -485,14 +497,22 @@ module Points = struct
     P2p_acl.banned_addr pool.acl addr
 
   let ban pool (addr, _port) =
-    P2p_acl.IPBlacklist.add pool.acl addr
+    P2p_acl.IPBlacklist.add pool.acl addr ;
+    (* Kick [addr]:* if it is in `Running` state. *)
+    List.iter (fun conn ->
+        conn.wait_close <- false ;
+        Lwt.async (fun () -> Answerer.shutdown (Lazy.force conn.answerer))
+      ) (connections_of_addr pool addr)
 
-  let trust pool (addr, _port) =
+  let unban pool (addr, _port) =
     P2p_acl.IPBlacklist.remove pool.acl addr
 
-  let forget pool ((addr, _port) as point) =
+  let trust pool ((addr, _port) as point) =
-    unset_trusted pool point; (* remove from whitelist *)
+    P2p_acl.IPBlacklist.remove pool.acl addr ;
-    P2p_acl.IPBlacklist.remove pool.acl addr
+    set_trusted pool point
+
+  let untrust pool point =
+    unset_trusted pool point
 
 end
 
@@ -533,26 +553,23 @@ module Peers = struct
   let fold_connected pool ~init ~f =
     P2p_peer.Table.fold f pool.connected_peer_ids init
 
-  let forget pool peer =
-    Option.iter (get_addr pool peer) ~f:begin fun (addr, _port) ->
-      unset_trusted pool peer; (* remove from whitelist *)
-      P2p_acl.PeerBlacklist.remove pool.acl peer;
-      P2p_acl.IPBlacklist.remove pool.acl addr
-    end
-
   let ban pool peer =
-    Option.iter (get_addr pool peer) ~f:begin fun point ->
-      Points.ban pool point ;
     P2p_acl.PeerBlacklist.add pool.acl peer ;
-    end ;
     (* Kick [peer] if it is in `Running` state. *)
     Option.iter (connection_of_peer_id pool peer) ~f:begin fun conn ->
       conn.wait_close <- false ;
       Lwt.async (fun () -> Answerer.shutdown (Lazy.force conn.answerer))
     end
 
+  let unban pool peer =
+    P2p_acl.PeerBlacklist.remove pool.acl peer
+
   let trust pool peer =
-    Option.iter (get_addr pool peer) ~f:(Points.trust pool)
+    unban pool peer ;
+    set_trusted pool peer
+
+  let untrust pool peer =
+    unset_trusted pool peer
 
   let banned pool peer =
     P2p_acl.banned_peer pool.acl peer

src/lib_p2p/p2p_pool.mli

@@ -356,9 +356,10 @@ module Peers : sig
     f:(P2p_peer.Id.t ->  ('msg, 'peer_meta,'conn_meta) info -> 'a -> 'a) ->
     'a
 
-  val forget : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
   val ban : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
+  val unban : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
   val trust : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
+  val untrust : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
   val banned : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> bool
 
 end
@@ -391,9 +392,10 @@ module Points : sig
     f:(P2p_point.Id.t -> ('msg, 'peer_meta,'conn_meta) info  -> 'a -> 'a) ->
     'a
 
-  val forget : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
   val ban : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
+  val unban : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
   val trust : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
+  val untrust : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
   val banned : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> bool
 
 end

src/lib_shell_services/p2p_services.ml

@@ -171,29 +171,38 @@ module Points = struct
                       used for establishing P2P connections."
         RPC_path.(root / "network" / "points")
 
-    let forget =
-      RPC_service.get_service
-        ~query: RPC_query.empty
-        ~output: Data_encoding.empty
-        ~description:"Remove the given address from the whitelist/blacklist."
-        RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "forget" )
-
     let ban =
       RPC_service.get_service
         ~query: RPC_query.empty
         ~output: Data_encoding.empty
-        ~description:"Blacklist the given address."
+        ~description:"Blacklist the given address and remove it from the \
+                      whitelist if present."
         RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "ban" )
 
+    let unban =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.empty
+        ~description:"Remove an address from the blacklist."
+        RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "unban" )
+
     let trust =
       RPC_service.get_service
         ~query: RPC_query.empty
         ~output: Data_encoding.empty
-        ~description:"Trust a given address permanently. \
+        ~description:"Trust a given address permanently and remove it \
-                      Connections from this address can still be closed \
+                      from the blacklist if present. Connections from \
-                      on authentication if the peer is blacklisted or greylisted."
+                      this address can still be closed on \
+                      authentication if the peer is greylisted."
         RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "trust" )
 
+    let untrust =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.empty
+        ~description:"Remove an address from the whitelist."
+        RPC_path.(root / "network" / "points" /: P2p_point.Id.rpc_arg / "untrust" )
+
     let banned =
       RPC_service.get_service
         ~query: RPC_query.empty
@@ -211,9 +220,10 @@ module Points = struct
       (object method monitor = true end) ()
   let list ?(filter = []) ctxt = make_call S.list ctxt ()
       (object method filters = filter end) ()
-  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 unban ctxt peer_id = make_call1 S.unban ctxt peer_id () ()
   let trust ctxt peer_id = make_call1 S.trust ctxt peer_id () ()
+  let untrust ctxt peer_id = make_call1 S.untrust ctxt peer_id () ()
   let banned ctxt peer_id = make_call1 S.banned ctxt peer_id () ()
 
 end
@@ -254,28 +264,37 @@ module Peers = struct
         ~description:"List the peers the node ever met."
         RPC_path.(root / "network" / "peers")
 
-    let forget =
-      RPC_service.get_service
-        ~query: RPC_query.empty
-        ~output: Data_encoding.empty
-        ~description:"Remove the given peer from the whitelist/blacklist."
-        RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "forget" )
-
     let ban =
       RPC_service.get_service
         ~query: RPC_query.empty
         ~output: Data_encoding.empty
-        ~description:"Blacklist the given peer."
+        ~description:"Blacklist the given peer and remove it from the \
+                      whitelist if present."
         RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "ban" )
 
+    let unban =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.empty
+        ~description:"Remove the given peer from the blacklist."
+        RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "unban" )
+
     let trust =
       RPC_service.get_service
         ~query: RPC_query.empty
         ~output: Data_encoding.empty
-        ~description:"Trust a given peer permanently: the peer cannot \
+        ~description:"Whitelist a given peer permanently and remove it \
+                      from the blacklist if present. The peer cannot \
                       be blocked (but its host IP still can)."
         RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "trust" )
 
+    let untrust =
+      RPC_service.get_service
+        ~query: RPC_query.empty
+        ~output: Data_encoding.empty
+        ~description:"Remove a given peer from the whitelist."
+        RPC_path.(root / "network" / "peers" /: P2p_peer.Id.rpc_arg / "untrust" )
+
     let banned =
       RPC_service.get_service
         ~query: RPC_query.empty
@@ -292,9 +311,10 @@ module Peers = struct
       (object method monitor = true end) ()
   let list ?(filter = []) ctxt =
     make_call S.list ctxt () (object method filters = filter end) ()
-  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 unban ctxt point_id = make_call1 S.unban ctxt point_id () ()
   let trust ctxt point_id = make_call1 S.trust ctxt point_id () ()
+  let untrust ctxt point_id = make_call1 S.untrust ctxt point_id () ()
   let banned ctxt point_id = make_call1 S.banned ctxt point_id () ()
 
 end

src/lib_shell_services/p2p_services.mli

@@ -112,12 +112,14 @@ module Points : sig
     P2p_point.Id.t ->
     (P2p_point.Pool_event.t list Lwt_stream.t * stopper) tzresult Lwt.t
 
-  val forget : #simple -> P2p_point.Id.t -> unit tzresult Lwt.t
-
   val ban: #simple -> P2p_point.Id.t -> unit tzresult Lwt.t
 
+  val unban: #simple -> P2p_point.Id.t -> unit tzresult Lwt.t
+
   val trust: #simple -> P2p_point.Id.t -> unit tzresult Lwt.t
 
+  val untrust: #simple -> P2p_point.Id.t -> unit tzresult Lwt.t
+
   val banned: #simple -> P2p_point.Id.t -> bool tzresult Lwt.t
 
   module S : sig
@@ -137,21 +139,26 @@ module Points : sig
        unit * P2p_point.Id.t, < monitor: bool>, unit,
        P2p_point.Pool_event.t list) RPC_service.t
 
-    val forget :
-      ([ `GET ], unit,
-       unit * P2p_point.Id.t, unit, unit,
-       unit) RPC_service.t
-
     val ban :
       ([ `GET ], unit,
        unit * P2p_point.Id.t, unit, unit,
        unit) RPC_service.t
 
+    val unban :
+      ([ `GET ], unit,
+       unit * P2p_point.Id.t, unit, unit,
+       unit) RPC_service.t
+
     val trust :
       ([ `GET ], unit,
        unit * P2p_point.Id.t, unit, unit,
        unit) RPC_service.t
 
+    val untrust :
+      ([ `GET ], unit,
+       unit * P2p_point.Id.t, unit, unit,
+       unit) RPC_service.t
+
     val banned :
       ([ `GET ], unit,
        unit * P2p_point.Id.t, unit, unit,
@@ -176,12 +183,14 @@ module Peers : sig
     #streamed -> P2p_peer.Id.t ->
     (P2p_peer.Pool_event.t list Lwt_stream.t * stopper) tzresult Lwt.t
 
-  val forget : #simple -> P2p_peer.Id.t -> unit tzresult Lwt.t
-
   val ban: #simple -> P2p_peer.Id.t -> unit tzresult Lwt.t
 
+  val unban: #simple -> P2p_peer.Id.t -> unit tzresult Lwt.t
+
   val trust: #simple -> P2p_peer.Id.t -> unit tzresult Lwt.t
 
+  val untrust: #simple -> P2p_peer.Id.t -> unit tzresult Lwt.t
+
   val banned: #simple -> P2p_peer.Id.t -> bool tzresult Lwt.t
 
   module S : sig
@@ -201,21 +210,26 @@ module Peers : sig
        unit * P2p_peer.Id.t, < monitor: bool>, unit,
        P2p_peer.Pool_event.t list) RPC_service.t
 
-    val forget :
-      ([ `GET ], unit,
-       unit * P2p_peer.Id.t, unit, unit,
-       unit) RPC_service.t
-
     val ban :
       ([ `GET ], unit,
        unit * P2p_peer.Id.t, unit, unit,
        unit) RPC_service.t
 
+    val unban :
+      ([ `GET ], unit,
+       unit * P2p_peer.Id.t, unit, unit,
+       unit) RPC_service.t
+
     val trust :
       ([ `GET ], unit,
        unit * P2p_peer.Id.t, unit, unit,
        unit) RPC_service.t
 
+    val untrust :
+      ([ `GET ], unit,
+       unit * P2p_peer.Id.t, unit, unit,
+       unit) RPC_service.t
+
     val banned :
       ([ `GET ], unit,
        unit * P2p_peer.Id.t, unit, unit,