diff --git a/src/Makefile b/src/Makefile index a01bdb62b..51160c2d5 100644 --- a/src/Makefile +++ b/src/Makefile @@ -495,6 +495,7 @@ CLIENT_LIB_INTFS := \ client/client_keys.mli \ client/client_protocols.mli \ client/client_blocks.mli \ + client/client_network.mli \ CLIENT_LIB_IMPLS := \ client/client_commands.ml \ @@ -506,6 +507,7 @@ CLIENT_LIB_IMPLS := \ client/client_keys.ml \ client/client_protocols.ml \ client/client_blocks.ml \ + client/client_network.ml \ WEBCLIENT_LIB_INTFS := \ diff --git a/src/client/client_network.ml b/src/client/client_network.ml new file mode 100644 index 000000000..b25dc41ea --- /dev/null +++ b/src/client/client_network.ml @@ -0,0 +1,69 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +let group = + { Cli_entries.name = "network" ; + title = "Commands for monitoring and controlling network state" } + +let commands () = [ + let open Cli_entries in + command ~group ~desc: "show global network status" + (prefixes ["network" ; "stat"] stop) begin fun cctxt -> + Client_node_rpcs.Network.stat cctxt >>= fun stat -> + Client_node_rpcs.Network.connections cctxt >>= fun conns -> + Client_node_rpcs.Network.peers cctxt >>= fun peers -> + Client_node_rpcs.Network.points cctxt >>= fun points -> + cctxt.message "GLOBAL STATS" >>= fun () -> + cctxt.message " %a" P2p_types.Stat.pp stat >>= fun () -> + cctxt.message "CONNECTIONS" >>= fun () -> + let incoming, outgoing = + List.partition (fun c -> c.P2p_types.Connection_info.incoming) conns in + Lwt_list.iter_s begin fun conn -> + cctxt.message " %a" P2p_types.Connection_info.pp conn + end incoming >>= fun () -> + Lwt_list.iter_s begin fun conn -> + cctxt.message " %a" P2p_types.Connection_info.pp conn + end outgoing >>= fun () -> + cctxt.message "KNOWN PEERS" >>= fun () -> + Lwt_list.iter_s begin fun (p, pi) -> + let open P2p.RPC.Peer_id in + cctxt.message " %a %.0f %a %a %s" + pp_state_digram pi.state + pi.score + pp p P2p_types.Stat.pp pi.stat + (if pi.trusted then "★" else " ") + end peers >>= fun () -> + cctxt.message "KNOWN POINTS" >>= fun () -> + Lwt_list.iter_s begin fun (p, pi) -> + let open P2p.RPC in + match pi.Point.state with + | Running peer_id -> + cctxt.message " %a %a %a %s" + Point.pp_state_digram pi.state + Point.pp p + Peer_id.pp peer_id + (if pi.trusted then "★" else " ") + | _ -> + match pi.last_seen with + | Some (peer_id, ts) -> + cctxt.message " %a %a (last seen: %a %a) %s" + Point.pp_state_digram pi.state + Point.pp p + Peer_id.pp peer_id + Time.pp_hum ts + (if pi.trusted then "★" else " ") + | None -> + cctxt.message " %a %a %s" + Point.pp_state_digram pi.state + Point.pp p + (if pi.trusted then "★" else " ") + end points >>= fun () -> + Lwt.return_unit + end +] diff --git a/src/client/client_network.mli b/src/client/client_network.mli new file mode 100644 index 000000000..8e0608798 --- /dev/null +++ b/src/client/client_network.mli @@ -0,0 +1,10 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2016. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +val commands: unit -> Client_commands.command list diff --git a/src/client/client_node_rpcs.ml b/src/client/client_node_rpcs.ml index 9c8c3c148..4e9649ab4 100644 --- a/src/client/client_node_rpcs.ml +++ b/src/client/client_node_rpcs.ml @@ -218,3 +218,14 @@ module Protocols = struct let list cctxt ?contents () = call_service0 cctxt Services.Protocols.list { contents; monitor = Some false } end + +module Network = struct + let stat cctxt = + call_service0 cctxt Services.Network.stat () + let connections cctxt = + call_service0 cctxt Services.Network.Connection.list () + let peers cctxt = + call_service0 cctxt Services.Network.Peer_id.list [] + let points cctxt = + call_service0 cctxt Services.Network.Point.list [] +end diff --git a/src/client/client_node_rpcs.mli b/src/client/client_node_rpcs.mli index 7d31a156e..bf1055603 100644 --- a/src/client/client_node_rpcs.mli +++ b/src/client/client_node_rpcs.mli @@ -152,6 +152,17 @@ end val bootstrapped: Client_commands.context -> (Block_hash.t * Time.t) Lwt_stream.t Lwt.t +module Network : sig + val stat: + Client_commands.context -> P2p_types.Stat.t Lwt.t + val connections: + Client_commands.context -> P2p_types.Connection_info.t list Lwt.t + val peers: + Client_commands.context -> (P2p.Peer_id.t * P2p.RPC.Peer_id.info) list Lwt.t + val points: + Client_commands.context -> (P2p.Point.t * P2p.RPC.Point.info) list Lwt.t +end + val complete: Client_commands.context -> ?block:Blocks.block -> string -> string list Lwt.t diff --git a/src/client_main.ml b/src/client_main.ml index b193b679d..3fa7b8aad 100644 --- a/src/client_main.ml +++ b/src/client_main.ml @@ -54,6 +54,7 @@ let main () = >>= fun version -> let commands = Client_generic_rpcs.commands @ + Client_network.commands () @ Client_keys.commands () @ Client_protocols.commands () @ Client_helpers.commands () @ diff --git a/src/node/net/p2p.ml b/src/node/net/p2p.ml index 39840cf5c..ecc95dd30 100644 --- a/src/node/net/p2p.ml +++ b/src/node/net/p2p.ml @@ -461,26 +461,60 @@ module RPC = struct end module Point = struct + include Point + type state = | Requested - | Accepted - | Running + | Accepted of Peer_id.t + | Running of Peer_id.t | Disconnected + let peer_id_of_state = function + | Requested -> None + | Accepted pi -> Some pi + | Running pi -> Some pi + | Disconnected -> None + + let state_of_state_peerid state pi = match state, pi with + | Requested, _ -> Requested + | Accepted _, Some pi -> Accepted pi + | Running _, Some pi -> Running pi + | Disconnected, _ -> Disconnected + | _ -> invalid_arg "state_of_state_peerid" + + let pp_state_digram ppf = function + | Requested -> Format.fprintf ppf "⚎" + | Accepted _ -> Format.fprintf ppf "⚍" + | Running _ -> Format.fprintf ppf "⚌" + | Disconnected -> Format.fprintf ppf "⚏" + let state_encoding = let open Data_encoding in - string_enum [ - "requested", Requested ; - "accepted", Accepted ; - "running", Running ; - "disconnected", Disconnected ; + let branch_encoding name obj = + conv (fun x -> (), x) (fun ((), x) -> x) + (merge_objs + (obj1 (req "event_kind" (constant name))) obj) in + union ~tag_size:`Uint8 [ + case ~tag:0 (branch_encoding "requested" empty) + (function Requested -> Some () | _ -> None) + (fun () -> Requested) ; + case ~tag:1 (branch_encoding "accepted" + (obj1 (req "peer_id" Peer_id.encoding))) + (function Accepted peer_id -> Some peer_id | _ -> None) + (fun peer_id -> Accepted peer_id) ; + case ~tag:2 (branch_encoding "running" + (obj1 (req "peer_id" Peer_id.encoding))) + (function Running peer_id -> Some peer_id | _ -> None) + (fun peer_id -> Running peer_id) ; + case ~tag:3 (branch_encoding "disconnected" empty) + (function Disconnected -> Some () | _ -> None) + (fun () -> Disconnected) ; ] type info = { trusted : bool ; greylisted_until : Time.t ; state : state ; - peer_id : Peer_id.t option ; last_failed_connection : Time.t option ; last_rejected_connection : (Peer_id.t * Time.t) option ; last_established_connection : (Peer_id.t * Time.t) option ; @@ -492,26 +526,24 @@ module RPC = struct let info_encoding = let open Data_encoding in conv - (fun { trusted ; greylisted_until ; state ; peer_id ; + (fun { trusted ; greylisted_until ; state ; last_failed_connection ; last_rejected_connection ; last_established_connection ; last_disconnection ; - last_seen ; last_miss ; - } -> + last_seen ; last_miss } -> + let peer_id = peer_id_of_state state in (trusted, greylisted_until, state, peer_id, last_failed_connection, last_rejected_connection, last_established_connection, last_disconnection, - last_seen, last_miss) - ) + last_seen, last_miss)) (fun (trusted, greylisted_until, state, peer_id, last_failed_connection, last_rejected_connection, last_established_connection, last_disconnection, last_seen, last_miss) -> - { trusted ; greylisted_until ; state ; peer_id ; + let state = state_of_state_peerid state peer_id in + { trusted ; greylisted_until ; state ; last_failed_connection ; last_rejected_connection ; last_established_connection ; last_disconnection ; - last_seen ; last_miss ; - } - ) + last_seen ; last_miss }) (obj10 (req "trusted" bool) (dft "greylisted_until" Time.encoding Time.epoch) @@ -527,14 +559,14 @@ module RPC = struct let info_of_point_info i = let open P2p_connection_pool in let open P2p_connection_pool_types in - let state, peer_id = match Point_info.State.get i with - | Requested _ -> Requested, None - | Accepted { current_peer_id } -> Accepted, Some current_peer_id - | Running { current_peer_id } -> Running, Some current_peer_id - | Disconnected -> Disconnected, None in + let state = match Point_info.State.get i with + | Requested _ -> Requested + | Accepted { current_peer_id } -> Accepted current_peer_id + | Running { current_peer_id } -> Running current_peer_id + | Disconnected -> Disconnected in Point_info.{ trusted = trusted i ; - state ; peer_id ; + state ; greylisted_until = greylisted_until i ; last_failed_connection = last_failed_connection i ; last_rejected_connection = last_rejected_connection i ; @@ -576,7 +608,7 @@ module RPC = struct | None -> raise Not_found | Some pi -> P2p_connection_pool_types.Point_info.watch pi - let infos ?(restrict=[]) net = + let list ?(restrict=[]) net = match net.pool with | None -> [] | Some pool -> @@ -593,11 +625,18 @@ module RPC = struct end module Peer_id = struct + include Peer_id + type state = | Accepted | Running | Disconnected + let pp_state_digram ppf = function + | Accepted -> Format.fprintf ppf "⚎" + | Running -> Format.fprintf ppf "⚌" + | Disconnected -> Format.fprintf ppf "⚏" + let state_encoding = let open Data_encoding in string_enum [ @@ -716,7 +755,7 @@ module RPC = struct | None -> raise Not_found | Some gi -> P2p_connection_pool_types.Peer_info.watch gi - let infos ?(restrict=[]) net = + let list ?(restrict=[]) net = match net.pool with | None -> [] | Some pool -> diff --git a/src/node/net/p2p.mli b/src/node/net/p2p.mli index 6891146bc..dc6da4224 100644 --- a/src/node/net/p2p.mli +++ b/src/node/net/p2p.mli @@ -206,20 +206,21 @@ module RPC : sig end module Point : sig + include module type of Point type state = | Requested - | Accepted - | Running + | Accepted of Peer_id.t + | Running of Peer_id.t | Disconnected + val pp_state_digram : Format.formatter -> state -> unit val state_encoding : state Data_encoding.t type info = { trusted : bool ; greylisted_until : Time.t ; state : state ; - peer_id : Peer_id.t option ; last_failed_connection : Time.t option ; last_rejected_connection : (Peer_id.t * Time.t) option ; last_established_connection : (Peer_id.t * Time.t) option ; @@ -234,7 +235,7 @@ module RPC : sig val info : ('msg, 'meta) net -> Point.t -> info option - val infos : + val list : ?restrict:state list -> ('msg, 'meta) net -> (Point.t * info) list val events : ?max:int -> ?rev:bool -> ('msg, 'meta) net -> Point.t -> Event.t list @@ -243,12 +244,14 @@ module RPC : sig end module Peer_id : sig + include module type of Peer_id type state = | Accepted | Running | Disconnected + val pp_state_digram : Format.formatter -> state -> unit val state_encoding : state Data_encoding.t type info = { @@ -270,7 +273,7 @@ module RPC : sig val info : ('msg, 'meta) net -> Peer_id.t -> info option - val infos : + val list : ?restrict:state list -> ('msg, 'meta) net -> (Peer_id.t * info) list val events : ?max:int -> ?rev:bool -> ('msg, 'meta) net -> Peer_id.t -> Event.t list diff --git a/src/node/net/p2p_types.ml b/src/node/net/p2p_types.ml index 3c8eea341..39d76f775 100644 --- a/src/node/net/p2p_types.ml +++ b/src/node/net/p2p_types.ml @@ -18,6 +18,9 @@ module Version = struct minor : int ; } + let pp ppf { name ; major ; minor } = + Format.fprintf ppf "%s.%d.%d" name major minor + let encoding = let open Data_encoding in conv @@ -83,7 +86,7 @@ module Stat = struct let pp ppf stat = Format.fprintf ppf - "sent: %a (%a/s) recv: %a (%a/s)" + "↗ %a (%a/s) ↘ %a (%a/s)" print_size64 stat.total_sent print_size stat.current_outflow print_size64 stat.total_recv print_size stat.current_inflow @@ -314,14 +317,15 @@ module Connection_info = struct (req "versions" (list Version.encoding))) let pp ppf - { incoming ; id_point = (remote_addr, remote_port) ; peer_id } = - Format.fprintf ppf "%a:%a {%a}%s" - Ipaddr.V6.pp_hum remote_addr - (fun ppf port -> - match port with - | None -> Format.pp_print_string ppf "??" - | Some port -> Format.pp_print_int ppf port) remote_port + { incoming ; id_point = (remote_addr, remote_port) ; + remote_socket_port ; peer_id ; versions } = + let version = List.hd versions in + let point = match remote_port with + | None -> remote_addr, remote_socket_port + | Some port -> remote_addr, port in + Format.fprintf ppf "%s %a %a (%a)" + (if incoming then "↘" else "↗") Peer_id.pp peer_id - (if incoming then " (incoming)" else "") - + Point.pp point + Version.pp version end diff --git a/src/node/net/p2p_types.mli b/src/node/net/p2p_types.mli index dd2a71f82..e148b67b9 100644 --- a/src/node/net/p2p_types.mli +++ b/src/node/net/p2p_types.mli @@ -19,6 +19,7 @@ module Version : sig } (** Type of a protocol version. *) + val pp : Format.formatter -> t -> unit val encoding : t Data_encoding.t val common: t list -> t list -> t option end @@ -35,6 +36,7 @@ module Peer_id : sig val pp : Format.formatter -> t -> unit val pp_short : Format.formatter -> t -> unit val encoding : t Data_encoding.t + val of_string_exn : string -> t module Map : Map.S with type key = t module Set : Set.S with type elt = t module Table : Hashtbl.S with type key = t diff --git a/src/node/shell/node.ml b/src/node/shell/node.ml index 7275c2adc..5b0d71156 100644 --- a/src/node/shell/node.ml +++ b/src/node/shell/node.ml @@ -565,8 +565,8 @@ module RPC = struct let info (node : t) = P2p.RPC.Point.info node.p2p - let infos (node : t) restrict = - P2p.RPC.Point.infos ~restrict node.p2p + let list (node : t) restrict = + P2p.RPC.Point.list ~restrict node.p2p let events (node : t) = P2p.RPC.Point.events node.p2p @@ -581,8 +581,8 @@ module RPC = struct let info (node : t) = P2p.RPC.Peer_id.info node.p2p - let infos (node : t) restrict = - P2p.RPC.Peer_id.infos ~restrict node.p2p + let list (node : t) restrict = + P2p.RPC.Peer_id.list ~restrict node.p2p let events (node : t) = P2p.RPC.Peer_id.events node.p2p diff --git a/src/node/shell/node.mli b/src/node/shell/node.mli index 194e4ad12..a43e27f46 100644 --- a/src/node/shell/node.mli +++ b/src/node/shell/node.mli @@ -103,7 +103,7 @@ module RPC : sig end module Peer_id : sig - val infos : t -> + val list : t -> P2p.RPC.Peer_id.state list -> (P2p.Peer_id.t * P2p.RPC.Peer_id.info) list val info : t -> P2p.Peer_id.t -> P2p.RPC.Peer_id.info option val events : t -> P2p.Peer_id.t -> P2p.RPC.Peer_id.Event.t list @@ -112,7 +112,7 @@ module RPC : sig end module Point : sig - val infos : t -> + val list : t -> P2p.RPC.Point.state list -> (P2p.Point.t * P2p.RPC.Point.info) list val info : t -> P2p.Point.t -> P2p.RPC.Point.info option val events : t -> P2p.Point.t -> P2p.RPC.Point.Event.t list diff --git a/src/node/shell/node_rpc.ml b/src/node/shell/node_rpc.ml index 194a442c3..49744450d 100644 --- a/src/node/shell/node_rpc.ml +++ b/src/node/shell/node_rpc.ml @@ -490,8 +490,8 @@ let build_rpc_directory node = let dir = let implementation state = - Node.RPC.Network.Peer_id.infos node state |> RPC.Answer.return in - RPC.register0 dir Services.Network.Peer_id.infos implementation in + Node.RPC.Network.Peer_id.list node state |> RPC.Answer.return in + RPC.register0 dir Services.Network.Peer_id.list implementation in let dir = let implementation peer_id () = Node.RPC.Network.Peer_id.info node peer_id |> RPC.Answer.return in @@ -518,8 +518,8 @@ let build_rpc_directory node = let dir = let implementation state = - Node.RPC.Network.Point.infos node state |> RPC.Answer.return in - RPC.register0 dir Services.Network.Point.infos implementation in + Node.RPC.Network.Point.list node state |> RPC.Answer.return in + RPC.register0 dir Services.Network.Point.list implementation in let dir = let implementation point () = Node.RPC.Network.Point.info node point |> RPC.Answer.return in diff --git a/src/node/shell/node_rpc_services.ml b/src/node/shell/node_rpc_services.ml index 69f1f721c..39afb52c0 100644 --- a/src/node/shell/node_rpc_services.ml +++ b/src/node/shell/node_rpc_services.ml @@ -559,16 +559,6 @@ module Network = struct module Point = struct - let infos = - let filter = - obj1 (dft "filter" (list P2p.RPC.Point.state_encoding) []) in - RPC.service - ~input: filter - ~output: (list (tup2 P2p.Point.encoding P2p.RPC.Point.info_encoding)) - ~description:"List the pool of known `IP:port` \ - used for establishing P2P connections ." - RPC.Path.(root / "network" / "point") - let info = RPC.service ~input: empty @@ -583,19 +573,20 @@ module Network = struct ~description: "Monitor network events related to an `IP:addr`." RPC.Path.(root / "network" / "point" /: point_arg / "log") + let list = + let filter = + obj1 (dft "filter" (list P2p.RPC.Point.state_encoding) []) in + RPC.service + ~input: filter + ~output: (list (tup2 P2p.Point.encoding P2p.RPC.Point.info_encoding)) + ~description:"List the pool of known `IP:port` \ + used for establishing P2P connections ." + RPC.Path.(root / "network" / "point") + end module Peer_id = struct - let infos = - let filter = - obj1 (dft "filter" (list P2p.RPC.Peer_id.state_encoding) []) in - RPC.service - ~input: filter - ~output: (list (tup2 P2p.Peer_id.encoding P2p.RPC.Peer_id.info_encoding)) - ~description:"List the peers the node ever met." - RPC.Path.(root / "network" / "peer_id") - let info = RPC.service ~input: empty @@ -610,6 +601,15 @@ module Network = struct ~description:"Monitor network events related to a given peer." RPC.Path.(root / "network" / "peer_id" /: peer_id_arg / "log") + let list = + let filter = + obj1 (dft "filter" (list P2p.RPC.Peer_id.state_encoding) []) in + RPC.service + ~input: filter + ~output: (list (tup2 P2p.Peer_id.encoding P2p.RPC.Peer_id.info_encoding)) + ~description:"List the peers the node ever met." + RPC.Path.(root / "network" / "peer_id") + end end diff --git a/src/node/shell/node_rpc_services.mli b/src/node/shell/node_rpc_services.mli index 937e8aba8..3c1b70c9e 100644 --- a/src/node/shell/node_rpc_services.mli +++ b/src/node/shell/node_rpc_services.mli @@ -140,7 +140,7 @@ module Network : sig end module Point : sig - val infos : + val list : (unit, unit, P2p.RPC.Point.state list, (P2p.Point.t * P2p.RPC.Point.info) list) RPC.service val info : @@ -150,7 +150,7 @@ module Network : sig end module Peer_id : sig - val infos : + val list : (unit, unit, P2p.RPC.Peer_id.state list, (P2p.Peer_id.t * P2p.RPC.Peer_id.info) list) RPC.service val info :