balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

P2P/Shell: Split metadata into peer_metadata and conn_metadata

Browse Source 
Peer_metadata is meant to keep track of peer's score.

Conn_metadata is meant to keep track of connection configuration given
during Ack exchange.
This commit is contained in:
michael 2018-05-15 13:16:08 +02:00 committed by Grégoire Henry
parent c13b7dd39a
commit 3f1363b9ba
21 changed files with 513 additions and 329 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
src/lib_p2p/p2p.ml
View File

@ -9,10 +9,15 @@
include Logging.Make(struct let name = "p2p" end) include Logging.Make(struct let name = "p2p" end)
type 'meta meta_config = 'meta P2p_pool.meta_config = { type 'peer_meta peer_meta_config = 'peer_meta P2p_pool.peer_meta_config = {
encoding : 'meta Data_encoding.t; peer_meta_encoding : 'peer_meta Data_encoding.t ;
initial : 'meta; peer_meta_initial : 'peer_meta ;
score : 'meta -> float score : 'peer_meta -> float ;
}
type 'conn_meta conn_meta_config = 'conn_meta P2p_pool.conn_meta_config = {
conn_meta_encoding : 'conn_meta Data_encoding.t ;
conn_meta_value : P2p_peer.Id.t -> 'conn_meta ;
} }
type 'msg app_message_encoding = 'msg P2p_pool.encoding = type 'msg app_message_encoding = 'msg P2p_pool.encoding =
@ -146,23 +151,24 @@ let may_create_welcome_worker config limits pool =
port >>= fun w -> port >>= fun w ->
Lwt.return (Some w) Lwt.return (Some w)
type ('msg, 'meta) connection = ('msg, 'meta) P2p_pool.connection type ('msg, 'peer_meta, 'conn_meta) connection =
('msg, 'peer_meta, 'conn_meta) P2p_pool.connection
module Real = struct module Real = struct
type ('msg, 'meta) net = { type ('msg, 'peer_meta, 'conn_meta) net = {
config: config ; config: config ;
limits: limits ; limits: limits ;
io_sched: P2p_io_scheduler.t ; io_sched: P2p_io_scheduler.t ;
pool: ('msg, 'meta) P2p_pool.t ; pool: ('msg, 'peer_meta, 'conn_meta) P2p_pool.t ;
maintenance: 'meta P2p_maintenance.t ; maintenance: 'peer_meta P2p_maintenance.t ;
welcome: P2p_welcome.t option ; welcome: P2p_welcome.t option ;
} }
let create ~config ~limits meta_cfg msg_cfg = let create ~config ~limits meta_cfg conn_meta_cfg msg_cfg =
let io_sched = create_scheduler limits in let io_sched = create_scheduler limits in
create_connection_pool create_connection_pool
config limits meta_cfg msg_cfg io_sched >>= fun pool -> config limits meta_cfg conn_meta_cfg msg_cfg io_sched >>= fun pool ->
let maintenance = create_maintenance_worker limits pool in let maintenance = create_maintenance_worker limits pool in
may_create_welcome_worker config limits pool >>= fun welcome -> may_create_welcome_worker config limits pool >>= fun welcome ->
return { return {
@ -202,10 +208,10 @@ module Real = struct
P2p_pool.Connection.stat conn P2p_pool.Connection.stat conn
let global_stat { pool } () = let global_stat { pool } () =
P2p_pool.pool_stat pool P2p_pool.pool_stat pool
let set_metadata { pool } conn meta = let set_peer_metadata { pool } conn meta =
P2p_pool.Peers.set_metadata pool conn meta P2p_pool.Peers.set_peer_metadata pool conn meta
let get_metadata { pool } conn = let get_peer_metadata { pool } conn =
P2p_pool.Peers.get_metadata pool conn P2p_pool.Peers.get_peer_metadata pool conn
let recv _net conn = let recv _net conn =
P2p_pool.read conn >>=? fun msg -> P2p_pool.read conn >>=? fun msg ->
@ -307,32 +313,42 @@ module Fake = struct
end end
type ('msg, 'meta) t = { type ('msg, 'peer_meta, 'conn_meta) t = {
versions : P2p_version.t list ; versions : P2p_version.t list ;
peer_id : P2p_peer.Id.t ; peer_id : P2p_peer.Id.t ;
maintain : unit -> unit Lwt.t ; maintain : unit -> unit Lwt.t ;
roll : unit -> unit Lwt.t ; roll : unit -> unit Lwt.t ;
shutdown : unit -> unit Lwt.t ; shutdown : unit -> unit Lwt.t ;
connections : unit -> ('msg, 'meta) connection list ; connections : unit -> ('msg, 'peer_meta, 'conn_meta) connection list ;
find_connection : P2p_peer.Id.t -> ('msg, 'meta) connection option ; find_connection :
disconnect : ?wait:bool -> ('msg, 'meta) connection -> unit Lwt.t ; P2p_peer.Id.t -> ('msg, 'peer_meta, 'conn_meta) connection option ;
connection_info : ('msg, 'meta) connection -> P2p_connection.Info.t ; disconnect :
connection_stat : ('msg, 'meta) connection -> P2p_stat.t ; ?wait:bool -> ('msg, 'peer_meta, 'conn_meta) connection -> unit Lwt.t ;
connection_info :
('msg, 'peer_meta, 'conn_meta) connection -> P2p_connection.Info.t ;
connection_stat : ('msg, 'peer_meta, 'conn_meta) connection -> P2p_stat.t ;
global_stat : unit -> P2p_stat.t ; global_stat : unit -> P2p_stat.t ;
get_metadata : P2p_peer.Id.t -> 'meta ; get_peer_metadata : P2p_peer.Id.t -> 'peer_meta ;
set_metadata : P2p_peer.Id.t -> 'meta -> unit ; set_peer_metadata : P2p_peer.Id.t -> 'peer_meta -> unit ;
recv : ('msg, 'meta) connection -> 'msg tzresult Lwt.t ; recv : ('msg, 'peer_meta, 'conn_meta) connection -> 'msg tzresult Lwt.t ;
recv_any : unit -> (('msg, 'meta) connection * 'msg) Lwt.t ; recv_any : unit -> (('msg, 'peer_meta, 'conn_meta) connection * 'msg) Lwt.t ;
send : ('msg, 'meta) connection -> 'msg -> unit tzresult Lwt.t ; send :
try_send : ('msg, 'meta) connection -> 'msg -> bool ; ('msg, 'peer_meta, 'conn_meta) connection -> 'msg -> unit tzresult Lwt.t ;
try_send : ('msg, 'peer_meta, 'conn_meta) connection -> 'msg -> bool ;
broadcast : 'msg -> unit ; broadcast : 'msg -> unit ;
pool : ('msg, 'meta) P2p_pool.t option ; pool : ('msg, 'peer_meta, 'conn_meta) P2p_pool.t option ;
fold_connections : fold_connections :
'a. init:'a -> f:(P2p_peer.Id.t -> ('msg, 'meta) connection -> 'a -> 'a) -> 'a ; 'a. init: 'a ->
iter_connections : (P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit ; f:(P2p_peer.Id.t ->
on_new_connection : (P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit ; ('msg, 'peer_meta, 'conn_meta) connection -> 'a -> 'a) -> 'a ;
iter_connections :
(P2p_peer.Id.t ->
('msg, 'peer_meta, 'conn_meta) connection -> unit) -> unit ;
on_new_connection :
(P2p_peer.Id.t ->
('msg, 'peer_meta, 'conn_meta) connection -> unit) -> unit ;
} }
type ('msg, 'meta) net = ('msg, 'meta) t type ('msg, 'peer_meta, 'conn_meta) net = ('msg, 'peer_meta, 'conn_meta) t
let check_limits = let check_limits =
let fail_1 v orig = let fail_1 v orig =
@ -372,9 +388,9 @@ let check_limits =
end >>=? fun () -> end >>=? fun () ->
return () return ()
let create ~config ~limits meta_cfg msg_cfg = let create ~config ~limits peer_cfg conn_cfg msg_cfg =
check_limits limits >>=? fun () -> check_limits limits >>=? fun () ->
Real.create ~config ~limits meta_cfg msg_cfg >>=? fun net -> Real.create ~config ~limits peer_cfg conn_cfg msg_cfg >>=? fun net ->
return { return {
versions = msg_cfg.versions ; versions = msg_cfg.versions ;
peer_id = Real.peer_id net ; peer_id = Real.peer_id net ;
@ -387,8 +403,8 @@ let create ~config ~limits meta_cfg msg_cfg =
connection_info = Real.connection_info net ; connection_info = Real.connection_info net ;
connection_stat = Real.connection_stat net ; connection_stat = Real.connection_stat net ;
global_stat = Real.global_stat net ; global_stat = Real.global_stat net ;
get_metadata = Real.get_metadata net ; get_peer_metadata = Real.get_peer_metadata net ;
set_metadata = Real.set_metadata net ; set_peer_metadata = Real.set_peer_metadata net ;
recv = Real.recv net ; recv = Real.recv net ;
recv_any = Real.recv_any net ; recv_any = Real.recv_any net ;
send = Real.send net ; send = Real.send net ;
@ -400,7 +416,7 @@ let create ~config ~limits meta_cfg msg_cfg =
on_new_connection = Real.on_new_connection net ; on_new_connection = Real.on_new_connection net ;
} }
let faked_network meta_config = { let faked_network peer_cfg = {
versions = [] ; versions = [] ;
peer_id = Fake.id.peer_id ; peer_id = Fake.id.peer_id ;
maintain = Lwt.return ; maintain = Lwt.return ;
@ -412,8 +428,8 @@ let faked_network meta_config = {
connection_info = (fun _ -> Fake.connection_info) ; connection_info = (fun _ -> Fake.connection_info) ;
connection_stat = (fun _ -> Fake.empty_stat) ; connection_stat = (fun _ -> Fake.empty_stat) ;
global_stat = (fun () -> Fake.empty_stat) ; global_stat = (fun () -> Fake.empty_stat) ;
get_metadata = (fun _ -> meta_config.initial) ; get_peer_metadata = (fun _ -> peer_cfg.peer_meta_initial) ;
set_metadata = (fun _ _ -> ()) ; set_peer_metadata = (fun _ _ -> ()) ;
recv = (fun _ -> Lwt_utils.never_ending) ; recv = (fun _ -> Lwt_utils.never_ending) ;
recv_any = (fun () -> Lwt_utils.never_ending) ; recv_any = (fun () -> Lwt_utils.never_ending) ;
send = (fun _ _ -> fail P2p_errors.Connection_closed) ; send = (fun _ _ -> fail P2p_errors.Connection_closed) ;
@ -435,8 +451,8 @@ let find_connection net = net.find_connection
let connection_info net = net.connection_info let connection_info net = net.connection_info
let connection_stat net = net.connection_stat let connection_stat net = net.connection_stat
let global_stat net = net.global_stat () let global_stat net = net.global_stat ()
let get_metadata net = net.get_metadata let get_peer_metadata net = net.get_peer_metadata
let set_metadata net = net.set_metadata let set_peer_metadata net = net.set_peer_metadata
let recv net = net.recv let recv net = net.recv
let recv_any net = net.recv_any () let recv_any net = net.recv_any ()
let send net = net.send let send net = net.send

104
src/lib_p2p/p2p.mli
View File

@ -15,10 +15,15 @@
nodes. nodes.
*) *)
type 'meta meta_config = { type 'peer_meta peer_meta_config = {
encoding : 'meta Data_encoding.t; peer_meta_encoding : 'peer_meta Data_encoding.t;
initial : 'meta; peer_meta_initial : 'peer_meta;
score : 'meta -> float score : 'peer_meta -> float ;
}
type 'conn_meta conn_meta_config = {
conn_meta_encoding : 'conn_meta Data_encoding.t;
conn_meta_value : P2p_peer.Id.t -> 'conn_meta ;
} }
type 'msg app_message_encoding = Encoding : { type 'msg app_message_encoding = Encoding : {
@ -127,94 +132,123 @@ type limits = {
(** Type of a P2P layer instance, parametrized by: (** Type of a P2P layer instance, parametrized by:
['msg]: type of messages exchanged between peers ['msg]: type of messages exchanged between peers
['meta]: type of the metadata associated with peers (score, etc.) ['peer_meta]: type of the metadata associated with peers (score, etc.)
['conn_meta]: type of the metadata associated with connection (ack_cfg)
*) *)
type ('msg, 'meta) t type ('msg, 'peer_meta, 'conn_meta) t
type ('msg, 'meta) net = ('msg, 'meta) t type ('msg, 'peer_meta, 'conn_meta) net = ('msg, 'peer_meta, 'conn_meta) t
(** A faked p2p layer, which do not initiate any connection (** A faked p2p layer, which do not initiate any connection
nor open any listening socket *) nor open any listening socket *)
val faked_network : 'meta meta_config -> ('msg, 'meta) net val faked_network :
'peer_meta peer_meta_config ->
('msg, 'peer_meta, 'conn_meta) net
(** Main network initialisation function *) (** Main network initialisation function *)
val create : val create :
config:config -> limits:limits -> config:config -> limits:limits ->
'meta meta_config -> 'msg message_config -> ('msg, 'meta) net tzresult Lwt.t 'peer_meta peer_meta_config -> 'conn_meta conn_meta_config ->
'msg message_config -> ('msg, 'peer_meta, 'conn_meta) net tzresult Lwt.t
(** Return one's peer_id *) (** Return one's peer_id *)
val peer_id : ('msg, 'meta) net -> P2p_peer.Id.t val peer_id : ('msg, 'peer_meta, 'conn_meta) net -> P2p_peer.Id.t
(** A maintenance operation : try and reach the ideal number of peers *) (** A maintenance operation : try and reach the ideal number of peers *)
val maintain : ('msg, 'meta) net -> unit Lwt.t val maintain : ('msg, 'peer_meta, 'conn_meta) net -> unit Lwt.t
(** Voluntarily drop some peers and replace them by new buddies *) (** Voluntarily drop some peers and replace them by new buddies *)
val roll : ('msg, 'meta) net -> unit Lwt.t val roll : ('msg, 'peer_meta, 'conn_meta) net -> unit Lwt.t
(** Close all connections properly *) (** Close all connections properly *)
val shutdown : ('msg, 'meta) net -> unit Lwt.t val shutdown : ('msg, 'peer_meta, 'conn_meta) net -> unit Lwt.t
(** A connection to a peer *) (** A connection to a peer *)
type ('msg, 'meta) connection type ('msg, 'peer_meta, 'conn_meta) connection
(** Access the domain of active peers *) (** Access the domain of active peers *)
val connections : ('msg, 'meta) net -> ('msg, 'meta) connection list val connections :
('msg, 'peer_meta, 'conn_meta) net ->
('msg, 'peer_meta, 'conn_meta) connection list
(** Return the active peer with identity [peer_id] *) (** Return the active peer with identity [peer_id] *)
val find_connection : ('msg, 'meta) net -> P2p_peer.Id.t -> ('msg, 'meta) connection option val find_connection :
('msg, 'peer_meta, 'conn_meta) net ->
P2p_peer.Id.t ->
('msg, 'peer_meta, 'conn_meta) connection option
(** Access the info of an active peer, if available *) (** Access the info of an active peer, if available *)
val connection_info : val connection_info :
('msg, 'meta) net -> ('msg, 'meta) connection -> P2p_connection.Info.t ('msg, 'peer_meta, 'conn_meta) net ->
('msg, 'peer_meta, 'conn_meta) connection ->
P2p_connection.Info.t
val connection_stat : val connection_stat :
('msg, 'meta) net -> ('msg, 'meta) connection -> P2p_stat.t ('msg, 'peer_meta, 'conn_meta) net ->
('msg, 'peer_meta, 'conn_meta) connection ->
P2p_stat.t
(** Cleanly closes a connection. *) (** Cleanly closes a connection. *)
val disconnect : val disconnect :
('msg, 'meta) net -> ?wait:bool -> ('msg, 'meta) connection -> unit Lwt.t ('msg, 'peer_meta, 'conn_meta) net ->
?wait:bool ->
('msg, 'peer_meta, 'conn_meta) connection ->
unit Lwt.t
val global_stat : ('msg, 'meta) net -> P2p_stat.t val global_stat : ('msg, 'peer_meta, 'conn_meta) net -> P2p_stat.t
(** Accessors for meta information about a global identifier *) (** Accessors for meta information about a global identifier *)
val get_metadata : ('msg, 'meta) net -> P2p_peer.Id.t -> 'meta val get_peer_metadata :
val set_metadata : ('msg, 'meta) net -> P2p_peer.Id.t -> 'meta -> unit ('msg, 'peer_meta, 'conn_meta) net -> P2p_peer.Id.t -> 'peer_meta
val set_peer_metadata :
('msg, 'peer_meta, 'conn_meta) net -> P2p_peer.Id.t -> 'peer_meta -> unit
(** Wait for a message from a given connection. *) (** Wait for a message from a given connection. *)
val recv : val recv :
('msg, 'meta) net -> ('msg, 'meta) connection -> 'msg tzresult Lwt.t ('msg, 'peer_meta, 'conn_meta) net ->
('msg, 'peer_meta, 'conn_meta) connection ->
'msg tzresult Lwt.t
(** Wait for a message from any active connections. *) (** Wait for a message from any active connections. *)
val recv_any : val recv_any :
('msg, 'meta) net -> (('msg, 'meta) connection * 'msg) Lwt.t ('msg, 'peer_meta, 'conn_meta) net ->
(('msg, 'peer_meta, 'conn_meta) connection * 'msg) Lwt.t
(** [send net peer msg] is a thread that returns when [msg] has been (** [send net peer msg] is a thread that returns when [msg] has been
successfully enqueued in the send queue. *) successfully enqueued in the send queue. *)
val send : val send :
('msg, 'meta) net -> ('msg, 'meta) connection -> 'msg -> unit tzresult Lwt.t ('msg, 'peer_meta, 'conn_meta) net ->
('msg, 'peer_meta, 'conn_meta) connection ->
'msg ->
unit tzresult Lwt.t
(** [try_send net peer msg] is [true] if [msg] has been added to the (** [try_send net peer msg] is [true] if [msg] has been added to the
send queue for [peer], [false] otherwise *) send queue for [peer], [false] otherwise *)
val try_send : val try_send :
('msg, 'meta) net -> ('msg, 'meta) connection -> 'msg -> bool ('msg, 'peer_meta, 'conn_meta) net ->
('msg, 'peer_meta, 'conn_meta) connection ->
'msg ->
bool
(** Send a message to all peers *) (** Send a message to all peers *)
val broadcast : ('msg, 'meta) net -> 'msg -> unit val broadcast : ('msg, 'peer_meta, 'conn_meta) net -> 'msg -> unit
val fold_connections : val fold_connections :
('msg, 'meta) net -> ('msg, 'peer_meta, 'conn_meta) net ->
init:'a -> f:(P2p_peer.Id.t -> ('msg, 'meta) connection -> 'a -> 'a) -> 'a init:'a ->
f:(P2p_peer.Id.t -> ('msg, 'peer_meta, 'conn_meta) connection -> 'a -> 'a) ->
'a
val iter_connections : val iter_connections :
('msg, 'meta) net -> ('msg, 'peer_meta, 'conn_meta) net ->
(P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit (P2p_peer.Id.t -> ('msg, 'peer_meta, 'conn_meta) connection -> unit) -> unit
val on_new_connection : val on_new_connection :
('msg, 'meta) net -> ('msg, 'peer_meta, 'conn_meta) net ->
(P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit (P2p_peer.Id.t -> ('msg, 'peer_meta, 'conn_meta) connection -> unit) -> unit
val build_rpc_directory : _ t -> unit RPC_directory.t val build_rpc_directory : _ t -> unit RPC_directory.t
val greylist_addr : ('msg, 'meta) net -> P2p_addr.t -> unit val greylist_addr : ('msg, 'peer_meta, 'conn_meta) net -> P2p_addr.t -> unit
val greylist_peer : ('msg, 'meta) net -> P2p_peer.Id.t -> unit val greylist_peer : ('msg, 'peer_meta, 'conn_meta) net -> P2p_peer.Id.t -> unit
(**/**) (**/**)

2
src/lib_p2p/p2p_maintenance.ml
View File

@ -16,7 +16,7 @@ type bounds = {
max_threshold: int ; max_threshold: int ;
} }
type 'meta pool = Pool : ('msg, 'meta) P2p_pool.t -> 'meta pool type 'meta pool = Pool : ('msg, 'meta, 'meta_conn) P2p_pool.t -> 'meta pool
type 'meta t = { type 'meta t = {
canceler: Lwt_canceler.t ; canceler: Lwt_canceler.t ;

2
src/lib_p2p/p2p_maintenance.mli
View File

@ -36,7 +36,7 @@ type bounds = {
type 'meta t type 'meta t
(** Type of a maintenance worker. *) (** Type of a maintenance worker. *)
val run: bounds -> ('msg, 'meta) P2p_pool.t -> 'meta t val run: bounds -> ('msg, 'meta, 'meta_conn) P2p_pool.t -> 'meta t
(** [run ~greylist_timeout bounds pool] is a maintenance worker for (** [run ~greylist_timeout bounds pool] is a maintenance worker for
[pool] with connection targets specified in [bounds]. *) [pool] with connection targets specified in [bounds]. *)

50
src/lib_p2p/p2p_peer_state.ml
View File

@ -9,13 +9,14 @@
open P2p_peer open P2p_peer
type 'data t = type ('conn, 'conn_meta) t =
| Accepted of { current_point: P2p_connection.Id.t ; | Accepted of { current_point: P2p_connection.Id.t ;
cancel: Lwt_canceler.t } cancel: Lwt_canceler.t }
| Running of { data: 'data ; | Running of { data: 'conn ;
conn_metadata: 'conn_meta ;
current_point: P2p_connection.Id.t } current_point: P2p_connection.Id.t }
| Disconnected | Disconnected
type 'data state = 'data t type ('conn, 'conn_meta) state = ('conn, 'conn_meta) t
let pp ppf = function let pp ppf = function
| Accepted { current_point ; _ } -> | Accepted { current_point ; _ } ->
@ -27,11 +28,11 @@ let pp ppf = function
module Info = struct module Info = struct
type ('conn, 'meta) t = { type ('conn, 'peer_meta, 'conn_meta) t = {
peer_id : Id.t ; peer_id : Id.t ;
created : Time.t ; created : Time.t ;
mutable state : 'conn state ; mutable state : ('conn, 'conn_meta) state ;
mutable metadata : 'meta ; mutable peer_metadata : 'peer_meta ;
mutable trusted : bool ; mutable trusted : bool ;
mutable last_failed_connection : (P2p_connection.Id.t * Time.t) option ; mutable last_failed_connection : (P2p_connection.Id.t * Time.t) option ;
mutable last_rejected_connection : (P2p_connection.Id.t * Time.t) option ; mutable last_rejected_connection : (P2p_connection.Id.t * Time.t) option ;
@ -40,17 +41,17 @@ module Info = struct
events : Pool_event.t Ring.t ; events : Pool_event.t Ring.t ;
watchers : Pool_event.t Lwt_watcher.input ; watchers : Pool_event.t Lwt_watcher.input ;
} }
type ('conn, 'meta) peer_info = ('conn, 'meta) t type ('conn, 'peer_meta, 'conn_meta) peer_info = ('conn, 'peer_meta, 'conn_meta) t
let compare gi1 gi2 = Id.compare gi1.peer_id gi2.peer_id let compare gi1 gi2 = Id.compare gi1.peer_id gi2.peer_id
let log_size = 100 let log_size = 100
let create ?(created = Time.now ()) ?(trusted = false) ~metadata peer_id = let create ?(created = Time.now ()) ?(trusted = false) ~peer_metadata peer_id =
{ peer_id ; { peer_id ;
created ; created ;
state = Disconnected ; state = Disconnected ;
metadata ; peer_metadata ;
trusted ; trusted ;
last_failed_connection = None ; last_failed_connection = None ;
last_rejected_connection = None ; last_rejected_connection = None ;
@ -60,23 +61,23 @@ module Info = struct
watchers = Lwt_watcher.create_input () ; watchers = Lwt_watcher.create_input () ;
} }
let encoding metadata_encoding = let encoding peer_metadata_encoding =
let open Data_encoding in let open Data_encoding in
conv conv
(fun { peer_id ; trusted ; metadata ; events ; created ; (fun { peer_id ; trusted ; peer_metadata ; events ; created ;
last_failed_connection ; last_rejected_connection ; last_failed_connection ; last_rejected_connection ;
last_established_connection ; last_disconnection ; _ } -> last_established_connection ; last_disconnection ; _ } ->
(peer_id, created, trusted, metadata, Ring.elements events, (peer_id, created, trusted, peer_metadata, Ring.elements events,
last_failed_connection, last_rejected_connection, last_failed_connection, last_rejected_connection,
last_established_connection, last_disconnection)) last_established_connection, last_disconnection))
(fun (peer_id, created, trusted, metadata, event_list, (fun (peer_id, created, trusted, peer_metadata, event_list,
last_failed_connection, last_rejected_connection, last_failed_connection, last_rejected_connection,
last_established_connection, last_disconnection) -> last_established_connection, last_disconnection) ->
let info = create ~trusted ~metadata peer_id in let info = create ~trusted ~peer_metadata peer_id in
let events = Ring.create log_size in let events = Ring.create log_size in
Ring.add_list info.events event_list ; Ring.add_list info.events event_list ;
{ state = Disconnected ; { state = Disconnected ;
trusted ; peer_id ; metadata ; created ; trusted ; peer_id ; peer_metadata ; created ;
last_failed_connection ; last_failed_connection ;
last_rejected_connection ; last_rejected_connection ;
last_established_connection ; last_established_connection ;
@ -88,7 +89,7 @@ module Info = struct
(req "peer_id" Id.encoding) (req "peer_id" Id.encoding)
(req "created" Time.encoding) (req "created" Time.encoding)
(dft "trusted" bool false) (dft "trusted" bool false)
(req "metadata" metadata_encoding) (req "peer_metadata" peer_metadata_encoding)
(dft "events" (list Pool_event.encoding) []) (dft "events" (list Pool_event.encoding) [])
(opt "last_failed_connection" (opt "last_failed_connection"
(tup2 P2p_connection.Id.encoding Time.encoding)) (tup2 P2p_connection.Id.encoding Time.encoding))
@ -101,8 +102,8 @@ module Info = struct
let peer_id { peer_id ; _ } = peer_id let peer_id { peer_id ; _ } = peer_id
let created { created ; _ } = created let created { created ; _ } = created
let metadata { metadata ; _ } = metadata let peer_metadata { peer_metadata ; _ } = peer_metadata
let set_metadata gi metadata = gi.metadata <- metadata let set_peer_metadata gi peer_metadata = gi.peer_metadata <- peer_metadata
let trusted { trusted ; _ } = trusted let trusted { trusted ; _ } = trusted
let set_trusted gi = gi.trusted <- true let set_trusted gi = gi.trusted <- true
let unset_trusted gi = gi.trusted <- false let unset_trusted gi = gi.trusted <- false
@ -130,18 +131,19 @@ module Info = struct
module File = struct module File = struct
let load path metadata_encoding = let load path peer_metadata_encoding =
let enc = Data_encoding.list (encoding metadata_encoding) in let enc =
Data_encoding.list (encoding peer_metadata_encoding) in
if path <> "/dev/null" && Sys.file_exists path then if path <> "/dev/null" && Sys.file_exists path then
Lwt_utils_unix.Json.read_file path >>=? fun json -> Lwt_utils_unix.Json.read_file path >>=? fun json ->
return (Data_encoding.Json.destruct enc json) return (Data_encoding.Json.destruct enc json)
else else
return [] return []
let save path metadata_encoding peers = let save path peer_metadata_encoding peers =
let open Data_encoding in let open Data_encoding in
Lwt_utils_unix.Json.write_file path @@ Lwt_utils_unix.Json.write_file path @@
Json.construct (list (encoding metadata_encoding)) peers Json.construct (list (encoding peer_metadata_encoding)) peers
end end
@ -170,7 +172,7 @@ let set_accepted
let set_running let set_running
?(timestamp = Time.now ()) ?(timestamp = Time.now ())
peer_info point data = peer_info point data conn_metadata =
assert begin assert begin
match peer_info.Info.state with match peer_info.Info.state with
| Disconnected -> true (* request to unknown peer_id. *) | Disconnected -> true (* request to unknown peer_id. *)
@ -178,7 +180,7 @@ let set_running
| Accepted { current_point ; _ } -> | Accepted { current_point ; _ } ->
P2p_connection.Id.equal point current_point P2p_connection.Id.equal point current_point
end ; end ;
peer_info.state <- Running { data ; current_point = point } ; peer_info.state <- Running { data ; conn_metadata ; current_point = point } ;
peer_info.last_established_connection <- Some (point, timestamp) ; peer_info.last_established_connection <- Some (point, timestamp) ;
Info.log peer_info ~timestamp point Connection_established Info.log peer_info ~timestamp point Connection_established

68
src/lib_p2p/p2p_peer_state.mli
View File

@ -9,56 +9,57 @@
open P2p_peer open P2p_peer
type 'conn t = type ('conn, 'conn_meta) t =
| Accepted of { current_point: P2p_connection.Id.t ; | Accepted of { current_point: P2p_connection.Id.t ;
cancel: Lwt_canceler.t } cancel: Lwt_canceler.t }
(** We accepted a incoming connection, we greeted back and (** We accepted a incoming connection, we greeted back and
we are waiting for an acknowledgement. *) we are waiting for an acknowledgement. *)
| Running of { data: 'conn ; | Running of { data: 'conn ;
conn_metadata: 'conn_meta ;
current_point: P2p_connection.Id.t } current_point: P2p_connection.Id.t }
(** Successfully authentificated connection, normal business. *) (** Successfully authentificated connection, normal business. *)
| Disconnected | Disconnected
(** No connection established currently. *) (** No connection established currently. *)
type 'conn state = 'conn t type ('conn, 'conn_meta) state = ('conn, 'conn_meta) t
val pp : Format.formatter -> 'conn t -> unit val pp : Format.formatter -> ('conn, 'conn_meta) t -> unit
module Info : sig module Info : sig
type ('conn, 'meta) t type ('conn, 'peer_meta, 'conn_meta) t
type ('conn, 'meta) peer_info = ('conn, 'meta) t type ('conn, 'peer_meta, 'conn_meta) peer_info = ('conn, 'peer_meta, 'conn_meta) t
val compare : ('conn, 'meta) t -> ('conn, 'meta) t -> int val compare : ('conn, 'peer_meta, 'conn_meta) t -> ('conn, 'peer_meta, 'conn_meta) t -> int
val create : val create :
?created:Time.t -> ?created:Time.t ->
?trusted:bool -> ?trusted:bool ->
metadata:'meta -> peer_metadata:'peer_meta ->
Id.t -> ('conn, 'meta) peer_info Id.t -> ('conn, 'peer_meta, 'conn_meta) peer_info
(** [create ~trusted ~meta peer_id] is a freshly minted peer_id info for (** [create ~trusted ~meta peer_id] is a freshly minted peer_id info for
[peer_id]. *) [peer_id]. *)
val peer_id : ('conn, 'meta) peer_info -> Id.t val peer_id : ('conn, 'peer_meta, 'conn_meta) peer_info -> Id.t
val created : ('conn, 'meta) peer_info -> Time.t val created : ('conn, 'peer_meta, 'conn_meta) peer_info -> Time.t
val metadata : ('conn, 'meta) peer_info -> 'meta val peer_metadata : ('conn, 'peer_meta, 'conn_meta) peer_info -> 'peer_meta
val set_metadata : ('conn, 'meta) peer_info -> 'meta -> unit val set_peer_metadata : ('conn, 'peer_meta, 'conn_meta) peer_info -> 'peer_meta -> unit
val trusted : ('conn, 'meta) peer_info -> bool val trusted : ('conn, 'peer_meta, 'conn_meta) peer_info -> bool
val set_trusted : ('conn, 'meta) peer_info -> unit val set_trusted : ('conn, 'peer_meta, 'conn_meta) peer_info -> unit
val unset_trusted : ('conn, 'meta) peer_info -> unit val unset_trusted : ('conn, 'peer_meta, 'conn_meta) peer_info -> unit
val last_failed_connection : val last_failed_connection :
('conn, 'meta) peer_info -> (P2p_connection.Id.t * Time.t) option ('conn, 'peer_meta, 'conn_meta) peer_info -> (P2p_connection.Id.t * Time.t) option
val last_rejected_connection : val last_rejected_connection :
('conn, 'meta) peer_info -> (P2p_connection.Id.t * Time.t) option ('conn, 'peer_meta, 'conn_meta) peer_info -> (P2p_connection.Id.t * Time.t) option
val last_established_connection : val last_established_connection :
('conn, 'meta) peer_info -> (P2p_connection.Id.t * Time.t) option ('conn, 'peer_meta, 'conn_meta) peer_info -> (P2p_connection.Id.t * Time.t) option
val last_disconnection : val last_disconnection :
('conn, 'meta) peer_info -> (P2p_connection.Id.t * Time.t) option ('conn, 'peer_meta, 'conn_meta) peer_info -> (P2p_connection.Id.t * Time.t) option
val last_seen : val last_seen :
('conn, 'meta) peer_info -> (P2p_connection.Id.t * Time.t) option ('conn, 'peer_meta, 'conn_meta) peer_info -> (P2p_connection.Id.t * Time.t) option
(** [last_seen gi] is the most recent of: (** [last_seen gi] is the most recent of:
* last established connection * last established connection
@ -67,7 +68,7 @@ module Info : sig
*) *)
val last_miss : val last_miss :
('conn, 'meta) peer_info -> (P2p_connection.Id.t * Time.t) option ('conn, 'peer_meta, 'conn_meta) peer_info -> (P2p_connection.Id.t * Time.t) option
(** [last_miss gi] is the most recent of: (** [last_miss gi] is the most recent of:
* last failed connection * last failed connection
@ -77,39 +78,38 @@ module Info : sig
val log_incoming_rejection : val log_incoming_rejection :
?timestamp:Time.t -> ?timestamp:Time.t ->
('conn, 'meta) peer_info -> P2p_connection.Id.t -> unit ('conn, 'peer_meta, 'conn_meta) peer_info -> P2p_connection.Id.t -> unit
module File : sig module File : sig
val load : val load :
string -> 'meta Data_encoding.t -> string -> 'peer_meta Data_encoding.t ->
('conn, 'meta) peer_info list tzresult Lwt.t ('conn, 'peer_meta, 'conn_meta) peer_info list tzresult Lwt.t
val save : val save :
string -> 'meta Data_encoding.t -> string -> 'peer_meta Data_encoding.t ->
('conn, 'meta) peer_info list -> unit tzresult Lwt.t ('conn, 'peer_meta, 'conn_meta) peer_info list -> unit tzresult Lwt.t
end end
val fold : val fold :
('conn, 'meta) t -> init:'a -> f:('a -> Pool_event.t -> 'a) -> 'a ('conn, 'peer_meta, 'conn_meta) t -> init:'a -> f:('a -> Pool_event.t -> 'a) -> 'a
val watch : val watch :
('conn, 'meta) t -> Pool_event.t Lwt_stream.t * Lwt_watcher.stopper ('conn, 'peer_meta, 'conn_meta) t -> Pool_event.t Lwt_stream.t * Lwt_watcher.stopper
end end
val get : ('conn, 'peer_meta, 'conn_meta) Info.t -> ('conn, 'conn_meta) state
val get : ('conn, 'meta) Info.t -> 'conn state val is_disconnected : ('conn, 'peer_meta, 'conn_meta) Info.t -> bool
val is_disconnected : ('conn, 'meta) Info.t -> bool
val set_accepted : val set_accepted :
?timestamp:Time.t -> ?timestamp:Time.t ->
('conn, 'meta) Info.t -> P2p_connection.Id.t -> Lwt_canceler.t -> unit ('conn, 'peer_meta, 'conn_meta) Info.t -> P2p_connection.Id.t -> Lwt_canceler.t -> unit
val set_running : val set_running :
?timestamp:Time.t -> ?timestamp:Time.t ->
('conn, 'meta) Info.t -> P2p_connection.Id.t -> 'conn -> unit ('conn, 'peer_meta, 'conn_meta) Info.t -> P2p_connection.Id.t -> 'conn -> 'conn_meta -> unit
val set_disconnected : val set_disconnected :
?timestamp:Time.t -> ?timestamp:Time.t ->
?requested:bool -> ?requested:bool ->
('conn, 'meta) Info.t -> unit ('conn, 'peer_meta, 'conn_meta) Info.t -> unit

95
src/lib_p2p/p2p_pool.ml
View File

@ -192,10 +192,10 @@ type config = {
binary_chunks_size : int option ; binary_chunks_size : int option ;
} }
type 'meta meta_config = { type 'peer_meta peer_meta_config = {
encoding : 'meta Data_encoding.t; peer_meta_encoding : 'peer_meta Data_encoding.t ;
initial : 'meta; peer_meta_initial : 'peer_meta ;
score : 'meta -> float; score : 'peer_meta -> float ;
} }
type 'msg message_config = { type 'msg message_config = {
@ -203,17 +203,29 @@ type 'msg message_config = {
versions : P2p_version.t list; versions : P2p_version.t list;
} }
type ('msg, 'meta) t = { type 'conn_meta conn_meta_config = {
conn_meta_encoding : 'conn_meta Data_encoding.t ;
conn_meta_value : P2p_peer.Id.t -> 'conn_meta ;
}
type ('msg, 'peer_meta, 'conn_meta) t = {
config : config ; config : config ;
meta_config : 'meta meta_config ; peer_meta_config : 'peer_meta peer_meta_config ;
conn_meta_config : 'conn_meta conn_meta_config ;
message_config : 'msg message_config ; message_config : 'msg message_config ;
my_id_points : unit P2p_point.Table.t ; my_id_points : unit P2p_point.Table.t ;
known_peer_ids : known_peer_ids :
(('msg, 'meta) connection, 'meta) P2p_peer_state.Info.t P2p_peer.Table.t ; (('msg, 'peer_meta, 'conn_meta) connection,
'peer_meta,
'conn_meta) P2p_peer_state.Info.t P2p_peer.Table.t ;
connected_peer_ids : connected_peer_ids :
(('msg, 'meta) connection, 'meta) P2p_peer_state.Info.t P2p_peer.Table.t ; (('msg, 'peer_meta, 'conn_meta) connection,
known_points : ('msg, 'meta) connection P2p_point_state.Info.t P2p_point.Table.t ; 'peer_meta,
connected_points : ('msg, 'meta) connection P2p_point_state.Info.t P2p_point.Table.t ; 'conn_meta) P2p_peer_state.Info.t P2p_peer.Table.t ;
known_points :
('msg, 'peer_meta, 'conn_meta) connection P2p_point_state.Info.t P2p_point.Table.t ;
connected_points :
('msg, 'peer_meta, 'conn_meta) connection P2p_point_state.Info.t P2p_point.Table.t ;
incoming : Lwt_canceler.t P2p_point.Table.t ; incoming : Lwt_canceler.t P2p_point.Table.t ;
io_sched : P2p_io_scheduler.t ; io_sched : P2p_io_scheduler.t ;
encoding : 'msg Message.t Data_encoding.t ; encoding : 'msg Message.t Data_encoding.t ;
@ -221,7 +233,7 @@ type ('msg, 'meta) t = {
watcher : P2p_connection.Pool_event.t Lwt_watcher.input ; watcher : P2p_connection.Pool_event.t Lwt_watcher.input ;
acl : P2p_acl.t ; acl : P2p_acl.t ;
mutable new_connection_hook : mutable new_connection_hook :
(P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) list ; (P2p_peer.Id.t -> ('msg, 'peer_meta, 'conn_meta) connection -> unit) list ;
mutable latest_accepted_swap : Time.t ; mutable latest_accepted_swap : Time.t ;
mutable latest_succesfull_swap : Time.t ; mutable latest_succesfull_swap : Time.t ;
} }
@ -233,18 +245,20 @@ and events = {
new_connection : unit Lwt_condition.t ; new_connection : unit Lwt_condition.t ;
} }
and ('msg, 'meta) connection = { and ('msg, 'peer_meta, 'conn_meta) connection = {
canceler : Lwt_canceler.t ; canceler : Lwt_canceler.t ;
messages : (int * 'msg) Lwt_pipe.t ; messages : (int * 'msg) Lwt_pipe.t ;
conn : 'msg Message.t P2p_socket.t ; conn : 'msg Message.t P2p_socket.t ;
peer_info : (('msg, 'meta) connection, 'meta) P2p_peer_state.Info.t ; peer_info :
point_info : ('msg, 'meta) connection P2p_point_state.Info.t option ; (('msg, 'peer_meta, 'conn_meta) connection, 'peer_meta, 'conn_meta) P2p_peer_state.Info.t ;
point_info :
('msg, 'peer_meta, 'conn_meta) connection P2p_point_state.Info.t option ;
answerer : 'msg Answerer.t Lazy.t ; answerer : 'msg Answerer.t Lazy.t ;
mutable last_sent_swap_request : (Time.t * P2p_peer.Id.t) option ; mutable last_sent_swap_request : (Time.t * P2p_peer.Id.t) option ;
mutable wait_close : bool ; mutable wait_close : bool ;
} }
type ('msg, 'meta) pool = ('msg, 'meta) t type ('msg, 'peer_meta, 'conn_meta) pool = ('msg, 'peer_meta, 'conn_meta) t
module Pool_event = struct module Pool_event = struct
let wait_too_few_connections pool = let wait_too_few_connections pool =
@ -318,7 +332,7 @@ module Gc_peer_set = List.Bounded(struct
if score_cmp = 0 then Time.compare t t' else - score_cmp if score_cmp = 0 then Time.compare t t' else - score_cmp
end) end)
let gc_peer_ids ({ meta_config = { score } ; let gc_peer_ids ({ peer_meta_config = { score } ;
config = { max_known_peer_ids } ; config = { max_known_peer_ids } ;
known_peer_ids ; } as pool) = known_peer_ids ; } as pool) =
match max_known_peer_ids with match max_known_peer_ids with
@ -327,7 +341,7 @@ let gc_peer_ids ({ meta_config = { score } ;
let table = Gc_peer_set.create target in let table = Gc_peer_set.create target in
P2p_peer.Table.iter (fun peer_id peer_info -> P2p_peer.Table.iter (fun peer_id peer_info ->
let created = P2p_peer_state.Info.created peer_info in let created = P2p_peer_state.Info.created peer_info in
let score = score @@ P2p_peer_state.Info.metadata peer_info in let score = score @@ P2p_peer_state.Info.peer_metadata peer_info in
Gc_peer_set.insert (score, created, peer_id) table Gc_peer_set.insert (score, created, peer_id) table
) known_peer_ids ; ) known_peer_ids ;
let to_remove = Gc_peer_set.get table in let to_remove = Gc_peer_set.get table in
@ -340,7 +354,9 @@ let register_peer pool peer_id =
match P2p_peer.Table.find pool.known_peer_ids peer_id with match P2p_peer.Table.find pool.known_peer_ids peer_id with
| exception Not_found -> | exception Not_found ->
Lwt_condition.broadcast pool.events.new_peer () ; Lwt_condition.broadcast pool.events.new_peer () ;
let peer = P2p_peer_state.Info.create peer_id ~metadata:pool.meta_config.initial in let peer =
P2p_peer_state.Info.create peer_id
~peer_metadata:pool.peer_meta_config.peer_meta_initial in
Option.iter pool.config.max_known_peer_ids ~f:begin fun (max, _) -> Option.iter pool.config.max_known_peer_ids ~f:begin fun (max, _) ->
if P2p_peer.Table.length pool.known_peer_ids >= max then gc_peer_ids pool if P2p_peer.Table.length pool.known_peer_ids >= max then gc_peer_ids pool
end ; end ;
@ -421,7 +437,8 @@ let get_addr pool peer_id =
module Points = struct module Points = struct
type ('msg, 'meta) info = ('msg, 'meta) connection P2p_point_state.Info.t type ('msg, 'peer_meta, 'conn_meta) info =
('msg, 'peer_meta, 'conn_meta) connection P2p_point_state.Info.t
let info { known_points } point = let info { known_points } point =
P2p_point.Table.find_opt known_points point P2p_point.Table.find_opt known_points point
@ -461,21 +478,22 @@ end
module Peers = struct module Peers = struct
type ('msg, 'meta) info = (('msg, 'meta) connection, 'meta) P2p_peer_state.Info.t type ('msg, 'peer_meta, 'conn_meta) info =
(('msg, 'peer_meta, 'conn_meta) connection, 'peer_meta, 'conn_meta) P2p_peer_state.Info.t
let info { known_peer_ids } peer_id = let info { known_peer_ids } peer_id =
try Some (P2p_peer.Table.find known_peer_ids peer_id) try Some (P2p_peer.Table.find known_peer_ids peer_id)
with Not_found -> None with Not_found -> None
let get_metadata pool peer_id = let get_peer_metadata pool peer_id =
try P2p_peer_state.Info.metadata (P2p_peer.Table.find pool.known_peer_ids peer_id) try P2p_peer_state.Info.peer_metadata (P2p_peer.Table.find pool.known_peer_ids peer_id)
with Not_found -> pool.meta_config.initial with Not_found -> pool.peer_meta_config.peer_meta_initial
let get_score pool peer_id = let get_score pool peer_id =
pool.meta_config.score (get_metadata pool peer_id) pool.peer_meta_config.score (get_peer_metadata pool peer_id)
let set_metadata pool peer_id data = let set_peer_metadata pool peer_id data =
P2p_peer_state.Info.set_metadata (register_peer pool peer_id) data P2p_peer_state.Info.set_peer_metadata (register_peer pool peer_id) data
let get_trusted pool peer_id = let get_trusted pool peer_id =
try P2p_peer_state.Info.trusted (P2p_peer.Table.find pool.known_peer_ids peer_id) try P2p_peer_state.Info.trusted (P2p_peer.Table.find pool.known_peer_ids peer_id)
@ -561,7 +579,7 @@ module Connection = struct
let stat { conn } = let stat { conn } =
P2p_socket.stat conn P2p_socket.stat conn
let score { meta_config = { score }} meta = score meta let score { peer_meta_config = { score }} meta = score meta
let info { conn } = let info { conn } =
P2p_socket.info conn P2p_socket.info conn
@ -688,6 +706,7 @@ and authenticate pool ?point_info canceler fd point =
~incoming (P2p_io_scheduler.register pool.io_sched fd) point ~incoming (P2p_io_scheduler.register pool.io_sched fd) point
?listening_port:pool.config.listening_port ?listening_port:pool.config.listening_port
pool.config.identity pool.message_config.versions pool.config.identity pool.message_config.versions
pool.conn_meta_config.conn_meta_encoding
end ~on_error: begin fun err -> end ~on_error: begin fun err ->
begin match err with begin match err with
| [ Canceled ] -> | [ Canceled ] ->
@ -779,11 +798,13 @@ and authenticate pool ?point_info canceler fd point =
?incoming_message_queue_size:pool.config.incoming_message_queue_size ?incoming_message_queue_size:pool.config.incoming_message_queue_size
?outgoing_message_queue_size:pool.config.outgoing_message_queue_size ?outgoing_message_queue_size:pool.config.outgoing_message_queue_size
?binary_chunks_size:pool.config.binary_chunks_size ?binary_chunks_size:pool.config.binary_chunks_size
auth_fd pool.encoding >>= fun conn -> auth_fd
(pool.conn_meta_config.conn_meta_value info.peer_id)
pool.encoding >>=? fun (conn, ack_cfg) ->
lwt_debug "authenticate: %a -> Connected %a" lwt_debug "authenticate: %a -> Connected %a"
P2p_point.Id.pp point P2p_point.Id.pp point
P2p_connection.Info.pp info >>= fun () -> P2p_connection.Info.pp info >>= fun () ->
Lwt.return conn return (conn, ack_cfg)
end ~on_error: begin fun err -> end ~on_error: begin fun err ->
if incoming then if incoming then
log pool log pool
@ -795,7 +816,7 @@ and authenticate pool ?point_info canceler fd point =
~f:P2p_point_state.set_disconnected ; ~f:P2p_point_state.set_disconnected ;
P2p_peer_state.set_disconnected peer_info ; P2p_peer_state.set_disconnected peer_info ;
Lwt.return (Error err) Lwt.return (Error err)
end >>=? fun conn -> end >>=? fun (conn, ack_cfg) ->
let id_point = let id_point =
match info.id_point, Option.map ~f:P2p_point_state.Info.point point_info with match info.id_point, Option.map ~f:P2p_point_state.Info.point point_info with
| (addr, _), Some (_, port) -> addr, Some port | (addr, _), Some (_, port) -> addr, Some port
@ -803,7 +824,7 @@ and authenticate pool ?point_info canceler fd point =
return return
(create_connection (create_connection
pool conn pool conn
id_point connection_point_info peer_info version) id_point connection_point_info peer_info version ack_cfg)
end end
| _ -> begin | _ -> begin
log pool (Rejecting_request (point, info.id_point, info.peer_id)) ; log pool (Rejecting_request (point, info.id_point, info.peer_id)) ;
@ -819,7 +840,7 @@ and authenticate pool ?point_info canceler fd point =
fail (P2p_errors.Rejected info.peer_id) fail (P2p_errors.Rejected info.peer_id)
end end
and create_connection pool p2p_conn id_point point_info peer_info _version = and create_connection pool p2p_conn id_point point_info peer_info _version ack_cfg =
let peer_id = P2p_peer_state.Info.peer_id peer_info in let peer_id = P2p_peer_state.Info.peer_id peer_info in
let canceler = Lwt_canceler.create () in let canceler = Lwt_canceler.create () in
let size = let size =
@ -851,7 +872,7 @@ and create_connection pool p2p_conn id_point point_info peer_info _version =
P2p_point.Table.add pool.connected_points point point_info ; P2p_point.Table.add pool.connected_points point point_info ;
end ; end ;
log pool (Connection_established (id_point, peer_id)) ; log pool (Connection_established (id_point, peer_id)) ;
P2p_peer_state.set_running peer_info id_point conn ; P2p_peer_state.set_running peer_info id_point conn ack_cfg ;
P2p_peer.Table.add pool.connected_peer_ids peer_id peer_info ; P2p_peer.Table.add pool.connected_peer_ids peer_id peer_info ;
Lwt_condition.broadcast pool.events.new_connection () ; Lwt_condition.broadcast pool.events.new_connection () ;
Lwt_canceler.on_cancel canceler begin fun () -> Lwt_canceler.on_cancel canceler begin fun () ->
@ -1013,7 +1034,7 @@ let send_swap_request pool =
(***************************************************************************) (***************************************************************************)
let create config meta_config message_config io_sched = let create config peer_meta_config conn_meta_config message_config io_sched =
let events = { let events = {
too_few_connections = Lwt_condition.create () ; too_few_connections = Lwt_condition.create () ;
too_many_connections = Lwt_condition.create () ; too_many_connections = Lwt_condition.create () ;
@ -1021,7 +1042,7 @@ let create config meta_config message_config io_sched =
new_connection = Lwt_condition.create () ; new_connection = Lwt_condition.create () ;
} in } in
let pool = { let pool = {
config ; meta_config ; message_config ; config ; peer_meta_config ; conn_meta_config; message_config ;
my_id_points = P2p_point.Table.create 7 ; my_id_points = P2p_point.Table.create 7 ;
known_peer_ids = P2p_peer.Table.create 53 ; known_peer_ids = P2p_peer.Table.create 53 ;
connected_peer_ids = P2p_peer.Table.create 53 ; connected_peer_ids = P2p_peer.Table.create 53 ;
@ -1038,7 +1059,9 @@ let create config meta_config message_config io_sched =
latest_succesfull_swap = Time.epoch ; latest_succesfull_swap = Time.epoch ;
} in } in
List.iter (Points.set_trusted pool) config.trusted_points ; List.iter (Points.set_trusted pool) config.trusted_points ;
P2p_peer_state.Info.File.load config.peers_file meta_config.encoding >>= function P2p_peer_state.Info.File.load
config.peers_file
peer_meta_config.peer_meta_encoding >>= function
| Ok peer_ids -> | Ok peer_ids ->
List.iter List.iter
(fun peer_info -> (fun peer_info ->

189
src/lib_p2p/p2p_pool.mli
View File

@ -13,14 +13,15 @@
A pool and its connections are parametrized by the type of A pool and its connections are parametrized by the type of
messages exchanged over the connection and the type of messages exchanged over the connection and the type of
meta-information associated with a peer. The type [('msg, 'meta) meta-information associated with a peer. The type
[('msg, 'peer_meta,'conn_meta)
connection] is a wrapper on top of [P2p_socket.t] that adds connection] is a wrapper on top of [P2p_socket.t] that adds
meta-information, a data-structure describing the detailed state of meta-informations, data-structures describing the detailed state of
the connection, as well as a new message queue (referred to "app the peer and the connection, as well as a new message queue
message queue") that will only contain the messages from the (referred to "app message queue") that will only contain the
internal [P2p_socket.t] that needs to be examined by the higher messages from the internal [P2p_socket.t] that needs to be examined
layers. Some messages are directly processed by an internal worker by the higher layers. Some messages are directly processed by an
and thus never propagated above. *) internal worker and thus never propagated above. *)
type 'msg encoding = Encoding : { type 'msg encoding = Encoding : {
tag: int ; tag: int ;
@ -32,11 +33,12 @@ type 'msg encoding = Encoding : {
(** {1 Pool management} *) (** {1 Pool management} *)
type ('msg, 'meta) t type ('msg, 'peer_meta,'conn_meta) t
type ('msg, 'meta) pool = ('msg, 'meta) t type ('msg, 'peer_meta,'conn_meta) pool = ('msg, 'peer_meta,'conn_meta) t
(** The type of a pool of connections, parametrized by resp. the type (** The type of a pool of connections, parametrized by resp. the type
of messages and the meta-information associated to an identity. *) of messages and the meta-informations associated to an identity and
a connection. *)
type config = { type config = {
@ -121,10 +123,15 @@ type config = {
peers. Default value is 64 kB. *) peers. Default value is 64 kB. *)
} }
type 'meta meta_config = { type 'peer_meta peer_meta_config = {
encoding : 'meta Data_encoding.t; peer_meta_encoding : 'peer_meta Data_encoding.t ;
initial : 'meta; peer_meta_initial : 'peer_meta ;
score : 'meta -> float; score : 'peer_meta -> float ;
}
type 'conn_meta conn_meta_config = {
conn_meta_encoding : 'conn_meta Data_encoding.t ;
conn_meta_value : P2p_peer.Id.t -> 'conn_meta ;
} }
type 'msg message_config = { type 'msg message_config = {
@ -134,22 +141,23 @@ type 'msg message_config = {
val create: val create:
config -> config ->
'meta meta_config -> 'peer_meta peer_meta_config ->
'conn_meta conn_meta_config ->
'msg message_config -> 'msg message_config ->
P2p_io_scheduler.t -> P2p_io_scheduler.t ->
('msg, 'meta) pool Lwt.t ('msg, 'peer_meta,'conn_meta) pool Lwt.t
(** [create config meta_cfg msg_cfg io_sched] is a freshly minted (** [create config meta_cfg msg_cfg io_sched] is a freshly minted
pool. *) pool. *)
val destroy: ('msg, 'meta) pool -> unit Lwt.t val destroy: ('msg, 'peer_meta,'conn_meta) pool -> unit Lwt.t
(** [destroy pool] returns when member connections are either (** [destroy pool] returns when member connections are either
disconnected or canceled. *) disconnected or canceled. *)
val active_connections: ('msg, 'meta) pool -> int val active_connections: ('msg, 'peer_meta,'conn_meta) pool -> int
(** [active_connections pool] is the number of connections inside (** [active_connections pool] is the number of connections inside
[pool]. *) [pool]. *)
val pool_stat: ('msg, 'meta) pool -> P2p_stat.t val pool_stat: ('msg, 'peer_meta,'conn_meta) pool -> P2p_stat.t
(** [pool_stat pool] is a snapshot of current bandwidth usage for the (** [pool_stat pool] is a snapshot of current bandwidth usage for the
entire [pool]. *) entire [pool]. *)
@ -157,25 +165,25 @@ val config : _ pool -> config
(** [config pool] is the [config] argument passed to [pool] at (** [config pool] is the [config] argument passed to [pool] at
creation. *) creation. *)
val send_swap_request: ('msg, 'meta) pool -> unit val send_swap_request: ('msg, 'peer_meta,'conn_meta) pool -> unit
(** {2 Pool events} *) (** {2 Pool events} *)
module Pool_event : sig module Pool_event : sig
val wait_too_few_connections: ('msg, 'meta) pool -> unit Lwt.t val wait_too_few_connections: ('msg, 'peer_meta,'conn_meta) pool -> unit Lwt.t
(** [wait_too_few_connections pool] is determined when the number of (** [wait_too_few_connections pool] is determined when the number of
connections drops below the desired level. *) connections drops below the desired level. *)
val wait_too_many_connections: ('msg, 'meta) pool -> unit Lwt.t val wait_too_many_connections: ('msg, 'peer_meta,'conn_meta) pool -> unit Lwt.t
(** [wait_too_many_connections pool] is determined when the number of (** [wait_too_many_connections pool] is determined when the number of
connections exceeds the desired level. *) connections exceeds the desired level. *)
val wait_new_peer: ('msg, 'meta) pool -> unit Lwt.t val wait_new_peer: ('msg, 'peer_meta,'conn_meta) pool -> unit Lwt.t
(** [wait_new_peer pool] is determined when a new peer (** [wait_new_peer pool] is determined when a new peer
(i.e. authentication successful) gets added to the pool. *) (i.e. authentication successful) gets added to the pool. *)
val wait_new_connection: ('msg, 'meta) pool -> unit Lwt.t val wait_new_connection: ('msg, 'peer_meta,'conn_meta) pool -> unit Lwt.t
(** [wait_new_connection pool] is determined when a new connection is (** [wait_new_connection pool] is determined when a new connection is
succesfully established in the pool. *) succesfully established in the pool. *)
@ -184,142 +192,154 @@ end
(** {1 Connections management} *) (** {1 Connections management} *)
type ('msg, 'meta) connection type ('msg, 'peer_meta,'conn_meta) connection
(** Type of a connection to a peer, parametrized by the type of (** Type of a connection to a peer, parametrized by the type of
messages exchanged as well as meta-information associated to a messages exchanged as well as meta-information associated to a
peer. It mostly wraps [P2p_connection.connection], adding peer and a connection. It mostly wraps [P2p_connection.connection],
meta-information and data-structures describing a more adding meta-information and data-structures describing a more
fine-grained logical state of the connection. *) fine-grained logical state of the connection. *)
val connect: val connect:
?timeout:float -> ?timeout:float ->
('msg, 'meta) pool -> P2p_point.Id.t -> ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t ->
('msg, 'meta) connection tzresult Lwt.t ('msg, 'peer_meta,'conn_meta) connection tzresult Lwt.t
(** [connect ?timeout pool point] tries to add a connection to [point] (** [connect ?timeout pool point] tries to add a connection to [point]
in [pool] in less than [timeout] seconds. *) in [pool] in less than [timeout] seconds. *)
val accept: val accept:
('msg, 'meta) pool -> Lwt_unix.file_descr -> P2p_point.Id.t -> unit ('msg, 'peer_meta,'conn_meta) pool -> Lwt_unix.file_descr -> P2p_point.Id.t -> unit
(** [accept pool fd point] instructs [pool] to start the process of (** [accept pool fd point] instructs [pool] to start the process of
accepting a connection from [fd]. Used by [P2p]. *) accepting a connection from [fd]. Used by [P2p]. *)
val disconnect: val disconnect:
?wait:bool -> ('msg, 'meta) connection -> unit Lwt.t ?wait:bool -> ('msg, 'peer_meta,'conn_meta) connection -> unit Lwt.t
(** [disconnect conn] cleanly closes [conn] and returns after [conn]'s (** [disconnect conn] cleanly closes [conn] and returns after [conn]'s
internal worker has returned. *) internal worker has returned. *)
module Connection : sig module Connection : sig
val info: ('msg, 'meta) connection -> P2p_connection.Info.t val info: ('msg, 'peer_meta,'conn_meta) connection -> P2p_connection.Info.t
val stat: ('msg, 'meta) connection -> P2p_stat.t val stat: ('msg, 'peer_meta,'conn_meta) connection -> P2p_stat.t
(** [stat conn] is a snapshot of current bandwidth usage for (** [stat conn] is a snapshot of current bandwidth usage for
[conn]. *) [conn]. *)
val fold: val fold:
('msg, 'meta) pool -> ('msg, 'peer_meta,'conn_meta) pool ->
init:'a -> init:'a ->
f:(P2p_peer.Id.t -> ('msg, 'meta) connection -> 'a -> 'a) -> f:(P2p_peer.Id.t -> ('msg, 'peer_meta,'conn_meta) connection -> 'a -> 'a) ->
'a 'a
val list: val list:
('msg, 'meta) pool -> (P2p_peer.Id.t * ('msg, 'meta) connection) list ('msg, 'peer_meta,'conn_meta) pool ->
(P2p_peer.Id.t * ('msg, 'peer_meta,'conn_meta) connection) list
val find_by_point: val find_by_point:
('msg, 'meta) pool -> P2p_point.Id.t -> ('msg, 'meta) connection option ('msg, 'peer_meta,'conn_meta) pool ->
P2p_point.Id.t ->
('msg, 'peer_meta,'conn_meta) connection option
val find_by_peer_id: val find_by_peer_id:
('msg, 'meta) pool -> P2p_peer.Id.t -> ('msg, 'meta) connection option ('msg, 'peer_meta,'conn_meta) pool ->
P2p_peer.Id.t ->
('msg, 'peer_meta,'conn_meta) connection option
end end
val on_new_connection: val on_new_connection:
('msg, 'meta) pool -> ('msg, 'peer_meta,'conn_meta) pool ->
(P2p_peer.Id.t -> ('msg, 'meta) connection -> unit) -> unit (P2p_peer.Id.t -> ('msg, 'peer_meta,'conn_meta) connection -> unit) -> unit
(** {1 I/O on connections} *) (** {1 I/O on connections} *)
val read: ('msg, 'meta) connection -> 'msg tzresult Lwt.t val read: ('msg, 'peer_meta,'conn_meta) connection -> 'msg tzresult Lwt.t
(** [read conn] returns a message popped from [conn]'s app message (** [read conn] returns a message popped from [conn]'s app message
queue, or fails with [Connection_closed]. *) queue, or fails with [Connection_closed]. *)
val is_readable: ('msg, 'meta) connection -> unit tzresult Lwt.t val is_readable: ('msg, 'peer_meta,'conn_meta) connection -> unit tzresult Lwt.t
(** [is_readable conn] returns when there is at least one message (** [is_readable conn] returns when there is at least one message
ready to be read. *) ready to be read. *)
val write: ('msg, 'meta) connection -> 'msg -> unit tzresult Lwt.t val write:
('msg, 'peer_meta,'conn_meta) connection -> 'msg -> unit tzresult Lwt.t
(** [write conn msg] is [P2p_connection.write conn' msg] where [conn'] (** [write conn msg] is [P2p_connection.write conn' msg] where [conn']
is the internal [P2p_connection.t] inside [conn]. *) is the internal [P2p_connection.t] inside [conn]. *)
val write_sync: ('msg, 'meta) connection -> 'msg -> unit tzresult Lwt.t val write_sync:
('msg, 'peer_meta,'conn_meta) connection -> 'msg -> unit tzresult Lwt.t
(** [write_sync conn msg] is [P2p_connection.write_sync conn' msg] (** [write_sync conn msg] is [P2p_connection.write_sync conn' msg]
where [conn'] is the internal [P2p_connection.t] inside [conn]. *) where [conn'] is the internal [P2p_connection.t] inside [conn]. *)
(**/**) (**/**)
val raw_write_sync: val raw_write_sync:
('msg, 'meta) connection -> MBytes.t -> unit tzresult Lwt.t ('msg, 'peer_meta,'conn_meta) connection -> MBytes.t -> unit tzresult Lwt.t
(**/**) (**/**)
val write_now: ('msg, 'meta) connection -> 'msg -> bool tzresult val write_now: ('msg, 'peer_meta,'conn_meta) connection -> 'msg -> bool tzresult
(** [write_now conn msg] is [P2p_connection.write_now conn' msg] where (** [write_now conn msg] is [P2p_connection.write_now conn' msg] where
[conn'] is the internal [P2p_connection.t] inside [conn]. *) [conn'] is the internal [P2p_connection.t] inside [conn]. *)
(** {2 Broadcast functions} *) (** {2 Broadcast functions} *)
val write_all: ('msg, 'meta) pool -> 'msg -> unit val write_all: ('msg, 'peer_meta,'conn_meta) pool -> 'msg -> unit
(** [write_all pool msg] is [write_now conn msg] for all member (** [write_all pool msg] is [write_now conn msg] for all member
connections to [pool] in [Running] state. *) connections to [pool] in [Running] state. *)
val broadcast_bootstrap_msg: ('msg, 'meta) pool -> unit val broadcast_bootstrap_msg: ('msg, 'peer_meta,'conn_meta) pool -> unit
(** [write_all pool msg] is [P2P_connection.write_now conn Bootstrap] (** [write_all pool msg] is [P2P_connection.write_now conn Bootstrap]
for all member connections to [pool] in [Running] state. *) for all member connections to [pool] in [Running] state. *)
val greylist_addr : ('msg, 'meta) pool -> P2p_addr.t -> unit val greylist_addr : ('msg, 'peer_meta,'conn_meta) pool -> P2p_addr.t -> unit
(** [greylist_addr pool addr] adds [addr] to [pool]'s IP greylist. *) (** [greylist_addr pool addr] adds [addr] to [pool]'s IP greylist. *)
val greylist_peer : ('msg, 'meta) pool -> P2p_peer.Id.t -> unit val greylist_peer : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
(** [greylist_peer pool peer] adds [peer] to [pool]'s peer greylist (** [greylist_peer pool peer] adds [peer] to [pool]'s peer greylist
and [peer]'s address to [pool]'s IP greylist. *) and [peer]'s address to [pool]'s IP greylist. *)
val gc_greylist: older_than:Time.t -> ('msg, 'meta) pool -> unit val gc_greylist: older_than:Time.t -> ('msg, 'peer_meta,'conn_meta) pool -> unit
(** [gc_greylist ~older_than pool] *) (** [gc_greylist ~older_than pool] *)
val acl_clear : ('msg, 'meta) pool -> unit val acl_clear : ('msg, 'peer_meta,'conn_meta) pool -> unit
(** [acl_clear pool] clears ACL tables. *) (** [acl_clear pool] clears ACL tables. *)
(** {1 Functions on [Peer_id]} *) (** {1 Functions on [Peer_id]} *)
module Peers : sig module Peers : sig
type ('msg, 'meta) info = (('msg, 'meta) connection, 'meta) P2p_peer_state.Info.t type ('msg, 'peer_meta,'conn_meta) info =
(('msg, 'peer_meta,'conn_meta) connection, 'peer_meta,'conn_meta) P2p_peer_state.Info.t
val info: val info:
('msg, 'meta) pool -> P2p_peer.Id.t -> ('msg, 'meta) info option ('msg, 'peer_meta,'conn_meta) pool ->
P2p_peer.Id.t ->
('msg, 'peer_meta,'conn_meta) info option
val get_metadata: ('msg, 'meta) pool -> P2p_peer.Id.t -> 'meta val get_peer_metadata:
val set_metadata: ('msg, 'meta) pool -> P2p_peer.Id.t -> 'meta -> unit ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> 'peer_meta
val get_score: ('msg, 'meta) pool -> P2p_peer.Id.t -> float val set_peer_metadata:
('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> 'peer_meta -> unit
val get_score: ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> float
val get_trusted: ('msg, 'meta) pool -> P2p_peer.Id.t -> bool val get_trusted: ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> bool
val set_trusted: ('msg, 'meta) pool -> P2p_peer.Id.t -> unit val set_trusted: ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
val unset_trusted: ('msg, 'meta) pool -> P2p_peer.Id.t -> unit val unset_trusted: ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
val fold_known: val fold_known:
('msg, 'meta) pool -> ('msg, 'peer_meta,'conn_meta) pool ->
init:'a -> init:'a ->
f:(P2p_peer.Id.t -> ('msg, 'meta) info -> 'a -> 'a) -> f:(P2p_peer.Id.t -> ('msg, 'peer_meta,'conn_meta) info -> 'a -> 'a) ->
'a 'a
val fold_connected: val fold_connected:
('msg, 'meta) pool -> ('msg, 'peer_meta,'conn_meta) pool ->
init:'a -> init:'a ->
f:(P2p_peer.Id.t -> ('msg, 'meta) info -> 'a -> 'a) -> f:(P2p_peer.Id.t -> ('msg, 'peer_meta,'conn_meta) info -> 'a -> 'a) ->
'a 'a
val forget : ('msg, 'meta) pool -> P2p_peer.Id.t -> unit val forget : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
val ban : ('msg, 'meta) pool -> P2p_peer.Id.t -> unit val ban : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
val trust : ('msg, 'meta) pool -> P2p_peer.Id.t -> unit val trust : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> unit
val banned : ('msg, 'meta) pool -> P2p_peer.Id.t -> bool val banned : ('msg, 'peer_meta,'conn_meta) pool -> P2p_peer.Id.t -> bool
end end
@ -327,35 +347,40 @@ end
module Points : sig module Points : sig
type ('msg, 'meta) info = ('msg, 'meta) connection P2p_point_state.Info.t type ('msg, 'peer_meta,'conn_meta) info =
('msg, 'peer_meta,'conn_meta) connection P2p_point_state.Info.t
val info: val info:
('msg, 'meta) pool -> P2p_point.Id.t -> ('msg, 'meta) info option ('msg, 'peer_meta,'conn_meta) pool ->
P2p_point.Id.t ->
('msg, 'peer_meta,'conn_meta) info option
val get_trusted: ('msg, 'meta) pool -> P2p_point.Id.t -> bool val get_trusted: ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> bool
val set_trusted: ('msg, 'meta) pool -> P2p_point.Id.t -> unit val set_trusted: ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
val unset_trusted: ('msg, 'meta) pool -> P2p_point.Id.t -> unit val unset_trusted: ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
val fold_known: val fold_known:
('msg, 'meta) pool -> ('msg, 'peer_meta,'conn_meta) pool ->
init:'a -> init:'a ->
f:(P2p_point.Id.t -> ('msg, 'meta) info -> 'a -> 'a) -> f:(P2p_point.Id.t -> ('msg, 'peer_meta,'conn_meta) info -> 'a -> 'a) ->
'a 'a
val fold_connected: val fold_connected:
('msg, 'meta) pool -> ('msg, 'peer_meta,'conn_meta) pool ->
init:'a -> init:'a ->
f:(P2p_point.Id.t -> ('msg, 'meta) info -> 'a -> 'a) -> f:(P2p_point.Id.t -> ('msg, 'peer_meta,'conn_meta) info -> 'a -> 'a) ->
'a 'a
val forget : ('msg, 'meta) pool -> P2p_point.Id.t -> unit val forget : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
val ban : ('msg, 'meta) pool -> P2p_point.Id.t -> unit val ban : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
val trust : ('msg, 'meta) pool -> P2p_point.Id.t -> unit val trust : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> unit
val banned : ('msg, 'meta) pool -> P2p_point.Id.t -> bool val banned : ('msg, 'peer_meta,'conn_meta) pool -> P2p_point.Id.t -> bool
end end
val watch: ('msg, 'meta) pool -> P2p_connection.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper val watch:
('msg, 'peer_meta,'conn_meta) pool ->
P2p_connection.Pool_event.t Lwt_stream.t * Lwt_watcher.stopper
(** [watch pool] is a [stream, close] a [stream] of events and a (** [watch pool] is a [stream, close] a [stream] of events and a
[close] function for this stream. *) [close] function for this stream. *)

115
src/lib_p2p/p2p_socket.ml
View File

@ -152,25 +152,67 @@ end
module Ack = struct module Ack = struct
type t = Ack | Nack type 'a t = Ack of 'a | Nack
let ack = MBytes.of_string "\255"
let nack = MBytes.of_string "\000"
let write cryptobox_data fd b = let encoding ack_encoding =
Crypto.write_chunk cryptobox_data fd let open Data_encoding in
(match b with Ack -> ack | Nack -> nack) let ack_encoding = obj1 (req "ack" ack_encoding) in
let nack_encoding = obj1 (req "nack" empty) in
let ack_case tag =
case tag ack_encoding
(function
| Ack param -> Some param
| _ -> None)
(fun param -> Ack param) in
let nack_case tag =
case tag nack_encoding
(function
| Nack -> Some ()
| _ -> None
)
(fun _ -> Nack) in
union [
ack_case (Tag 0) ;
nack_case (Tag 1) ;
]
let read fd cryptobox_data = let write ack_encoding cryptobox_data fd message =
let encoding = encoding ack_encoding in
let encoded_message_len =
Data_encoding.Binary.length encoding message in
let buf = MBytes.create encoded_message_len in
match Data_encoding.Binary.write encoding message buf 0 encoded_message_len with
| None ->
fail P2p_errors.Encoding_error
| Some last ->
fail_unless (last = encoded_message_len)
P2p_errors.Encoding_error >>=? fun () ->
Crypto.write_chunk cryptobox_data fd buf
let read ack_encoding fd cryptobox_data =
let encoding = encoding ack_encoding in
Crypto.read_chunk fd cryptobox_data >>=? fun buf -> Crypto.read_chunk fd cryptobox_data >>=? fun buf ->
return (buf <> nack) let length = MBytes.length buf in
match Data_encoding.Binary.read encoding buf 0 length with
| None ->
fail P2p_errors.Decoding_error
| Some (read_len, message) ->
if read_len <> length then
fail P2p_errors.Decoding_error
else
return message
end end
type authenticated_fd = type 'conn_meta authenticated_fd = {
P2p_io_scheduler.connection * P2p_connection.Info.t * Crypto.data fd: P2p_io_scheduler.connection ;
info: P2p_connection.Info.t ;
cryptobox_data: Crypto.data ;
ack_encoding: 'conn_meta Data_encoding.t ;
}
let kick (fd, _ , cryptobox_data) = let kick { fd ; ack_encoding ; cryptobox_data ; _ } =
Ack.write fd cryptobox_data Nack >>= fun _ -> Ack.write ack_encoding fd cryptobox_data Nack >>= fun _ ->
P2p_io_scheduler.close fd >>= fun _ -> P2p_io_scheduler.close fd >>= fun _ ->
Lwt.return_unit Lwt.return_unit
@ -180,7 +222,7 @@ let kick (fd, _ , cryptobox_data) =
let authenticate let authenticate
~proof_of_work_target ~proof_of_work_target
~incoming fd (remote_addr, remote_socket_port as point) ~incoming fd (remote_addr, remote_socket_port as point)
?listening_port identity supported_versions = ?listening_port identity supported_versions ack_encoding =
let local_nonce_seed = Crypto_box.random_nonce () in let local_nonce_seed = Crypto_box.random_nonce () in
lwt_debug "Sending authenfication to %a" P2p_point.Id.pp point >>= fun () -> lwt_debug "Sending authenfication to %a" P2p_point.Id.pp point >>= fun () ->
Connection_message.write fd Connection_message.write fd
@ -210,7 +252,7 @@ let authenticate
{ P2p_connection.Info.peer_id = remote_peer_id ; { P2p_connection.Info.peer_id = remote_peer_id ;
versions = msg.versions ; incoming ; versions = msg.versions ; incoming ;
id_point ; remote_socket_port ;} in id_point ; remote_socket_port ;} in
return (info, (fd, info, cryptobox_data)) return (info, { fd ; info ; cryptobox_data ; ack_encoding })
type connection = { type connection = {
id : int ; id : int ;
@ -449,33 +491,38 @@ let info { conn } = conn.info
let accept let accept
?incoming_message_queue_size ?outgoing_message_queue_size ?incoming_message_queue_size ?outgoing_message_queue_size
?binary_chunks_size (fd, info, cryptobox_data) encoding = ?binary_chunks_size
{ fd ; info ; cryptobox_data ; ack_encoding }
ack_param
encoding =
protect begin fun () -> protect begin fun () ->
Ack.write fd cryptobox_data Ack >>=? fun () -> Ack.write ack_encoding fd cryptobox_data (Ack ack_param) >>=? fun () ->
Ack.read fd cryptobox_data Ack.read ack_encoding fd cryptobox_data
end ~on_error:begin fun err -> end ~on_error:begin fun err ->
P2p_io_scheduler.close fd >>= fun _ -> P2p_io_scheduler.close fd >>= fun _ ->
match err with match err with
| [ P2p_errors.Connection_closed ] -> fail P2p_errors.Rejected_socket_connection | [ P2p_errors.Connection_closed ] -> fail P2p_errors.Rejected_socket_connection
| [ P2p_errors.Decipher_error ] -> fail P2p_errors.Invalid_auth | [ P2p_errors.Decipher_error ] -> fail P2p_errors.Invalid_auth
| err -> Lwt.return (Error err) | err -> Lwt.return (Error err)
end >>=? fun accepted -> end >>=? function
fail_unless accepted P2p_errors.Rejected_socket_connection >>=? fun () -> | Ack ack_cfg ->
let canceler = Lwt_canceler.create () in let canceler = Lwt_canceler.create () in
let conn = { id = next_conn_id () ; fd ; info ; cryptobox_data } in let conn = { id = next_conn_id () ; fd ; info ; cryptobox_data } in
let reader = let reader =
Reader.run ?size:incoming_message_queue_size conn encoding canceler Reader.run ?size:incoming_message_queue_size conn encoding canceler
and writer = and writer =
Writer.run Writer.run
?size:outgoing_message_queue_size ?binary_chunks_size ?size:outgoing_message_queue_size ?binary_chunks_size
conn encoding canceler conn encoding canceler
in in
let conn = { conn ; reader ; writer } in let conn = { conn ; reader ; writer } in
Lwt_canceler.on_cancel canceler begin fun () -> Lwt_canceler.on_cancel canceler begin fun () ->
P2p_io_scheduler.close fd >>= fun _ -> P2p_io_scheduler.close fd >>= fun _ ->
Lwt.return_unit Lwt.return_unit
end ; end ;
return conn return (conn, ack_cfg)
| Nack ->
fail P2p_errors.Rejected_socket_connection
let catch_closed_pipe f = let catch_closed_pipe f =
Lwt.catch f begin function Lwt.catch f begin function

14
src/lib_p2p/p2p_socket.mli
View File

@ -19,9 +19,10 @@
(** {1 Types} *) (** {1 Types} *)
type authenticated_fd type 'conn_meta authenticated_fd
(** Type of a connection that successfully passed the authentication (** Type of a connection that successfully passed the authentication
phase, but has not been accepted yet. *) phase, but has not been accepted yet. Parametrized by the type
of expected parameter in the `ack` message. *)
type 'msg t type 'msg t
(** Type of an accepted connection, parametrized by the type of (** Type of an accepted connection, parametrized by the type of
@ -39,14 +40,14 @@ val authenticate:
incoming:bool -> incoming:bool ->
P2p_io_scheduler.connection -> P2p_point.Id.t -> P2p_io_scheduler.connection -> P2p_point.Id.t ->
?listening_port: int -> ?listening_port: int ->
P2p_identity.t -> P2p_version.t list -> P2p_identity.t -> P2p_version.t list -> 'conn_meta Data_encoding.t ->
(P2p_connection.Info.t * authenticated_fd) tzresult Lwt.t (P2p_connection.Info.t * 'conn_meta authenticated_fd) tzresult Lwt.t
(** (Low-level) (Cancelable) Authentication function of a remote (** (Low-level) (Cancelable) Authentication function of a remote
peer. Used in [P2p_connection_pool], to promote a peer. Used in [P2p_connection_pool], to promote a
[P2P_io_scheduler.connection] into an [authenticated_fd] (auth [P2P_io_scheduler.connection] into an [authenticated_fd] (auth
correct, acceptation undecided). *) correct, acceptation undecided). *)
val kick: authenticated_fd -> unit Lwt.t val kick: 'conn_meta authenticated_fd -> unit Lwt.t
(** (Low-level) (Cancelable) [kick afd] notifies the remote peer that (** (Low-level) (Cancelable) [kick afd] notifies the remote peer that
we refuse this connection and then closes [afd]. Used in we refuse this connection and then closes [afd]. Used in
[P2p_connection_pool] to reject an [aunthenticated_fd] which we do [P2p_connection_pool] to reject an [aunthenticated_fd] which we do
@ -56,7 +57,8 @@ val accept:
?incoming_message_queue_size:int -> ?incoming_message_queue_size:int ->
?outgoing_message_queue_size:int -> ?outgoing_message_queue_size:int ->
?binary_chunks_size: int -> ?binary_chunks_size: int ->
authenticated_fd -> 'msg Data_encoding.t -> 'msg t tzresult Lwt.t 'conn_meta authenticated_fd -> 'conn_meta ->
'msg Data_encoding.t -> ('msg t * 'conn_meta) tzresult Lwt.t
(** (Low-level) (Cancelable) Accepts a remote peer given an (** (Low-level) (Cancelable) Accepts a remote peer given an
authenticated_fd. Used in [P2p_connection_pool], to promote an authenticated_fd. Used in [P2p_connection_pool], to promote an
[authenticated_fd] to the status of an active peer. *) [authenticated_fd] to the status of an active peer. *)

2
src/lib_p2p/p2p_welcome.ml
View File

@ -9,7 +9,7 @@
include Logging.Make (struct let name = "p2p.welcome" end) include Logging.Make (struct let name = "p2p.welcome" end)
type pool = Pool : ('msg, 'meta) P2p_pool.t -> pool type pool = Pool : ('msg, 'meta, 'meta_conn) P2p_pool.t -> pool
type t = { type t = {
socket: Lwt_unix.file_descr ; socket: Lwt_unix.file_descr ;

2
src/lib_p2p/p2p_welcome.mli
View File

@ -17,7 +17,7 @@ type t
val run: val run:
?addr:P2p_addr.t -> backlog:int -> ?addr:P2p_addr.t -> backlog:int ->
('msg, 'meta) P2p_pool.t -> P2p_addr.port -> t Lwt.t ('msg, 'meta, 'meta_conn) P2p_pool.t -> P2p_addr.port -> t Lwt.t
(** [run ?addr ~backlog pool port] returns a running welcome worker (** [run ?addr ~backlog pool port] returns a running welcome worker
adding connections into [pool] listening on [addr:port]. [backlog] adding connections into [pool] listening on [addr:port]. [backlog]
is passed to [Lwt_unix.listen]. *) is passed to [Lwt_unix.listen]. *)

13
src/lib_p2p/test/test_p2p_pool.ml
View File

@ -27,12 +27,17 @@ let msg_config : message P2p_pool.message_config = {
type metadata = unit type metadata = unit
let meta_config : metadata P2p_pool.meta_config = { let peer_meta_config : metadata P2p_pool.peer_meta_config = {
encoding = Data_encoding.empty ; peer_meta_encoding = Data_encoding.empty ;
initial = () ; peer_meta_initial = () ;
score = fun () -> 0. ; score = fun () -> 0. ;
} }
let conn_meta_config : metadata P2p_pool.conn_meta_config = {
conn_meta_encoding = Data_encoding.empty ;
conn_meta_value = (fun _ -> ()) ;
}
let sync ch = let sync ch =
Process.Channel.push ch () >>=? fun () -> Process.Channel.push ch () >>=? fun () ->
Process.Channel.pop ch >>=? fun () -> Process.Channel.pop ch >>=? fun () ->
@ -87,7 +92,7 @@ let detach_node f points n =
begin fun channel -> begin fun channel ->
let sched = P2p_io_scheduler.create ~read_buffer_size:(1 lsl 12) () in let sched = P2p_io_scheduler.create ~read_buffer_size:(1 lsl 12) () in
P2p_pool.create P2p_pool.create
config meta_config msg_config sched >>= fun pool -> config peer_meta_config conn_meta_config msg_config sched >>= fun pool ->
P2p_welcome.run ~backlog:10 pool ~addr port >>= fun welcome -> P2p_welcome.run ~backlog:10 pool ~addr port >>= fun welcome ->
lwt_log_info "Node ready (port: %d)" port >>= fun () -> lwt_log_info "Node ready (port: %d)" port >>= fun () ->
sync channel >>=? fun () -> sync channel >>=? fun () ->

32
src/lib_p2p/test/test_p2p_socket.ml
View File

@ -95,7 +95,7 @@ let accept sched main_socket =
raw_accept sched main_socket >>= fun (fd, point) -> raw_accept sched main_socket >>= fun (fd, point) ->
P2p_socket.authenticate P2p_socket.authenticate
~proof_of_work_target ~proof_of_work_target
~incoming:true fd point id1 versions ~incoming:true fd point id1 versions Data_encoding.unit
let raw_connect sched addr port = let raw_connect sched addr port =
let fd = Lwt_unix.socket PF_INET6 SOCK_STREAM 0 in let fd = Lwt_unix.socket PF_INET6 SOCK_STREAM 0 in
@ -109,7 +109,7 @@ let connect sched addr port id =
raw_connect sched addr port >>= fun fd -> raw_connect sched addr port >>= fun fd ->
P2p_socket.authenticate P2p_socket.authenticate
~proof_of_work_target ~proof_of_work_target
~incoming:false fd (addr, port) id versions >>=? fun (info, auth_fd) -> ~incoming:false fd (addr, port) id versions Data_encoding.unit >>=? fun (info, auth_fd) ->
_assert (not info.incoming) __LOC__ "" >>=? fun () -> _assert (not info.incoming) __LOC__ "" >>=? fun () ->
_assert (P2p_peer.Id.compare info.peer_id id1.peer_id = 0) _assert (P2p_peer.Id.compare info.peer_id id1.peer_id = 0)
__LOC__ "" >>=? fun () -> __LOC__ "" >>=? fun () ->
@ -172,7 +172,7 @@ module Kick = struct
let client _ch sched addr port = let client _ch sched addr port =
connect sched addr port id2 >>=? fun auth_fd -> connect sched addr port id2 >>=? fun auth_fd ->
P2p_socket.accept auth_fd encoding >>= fun conn -> P2p_socket.accept auth_fd () encoding >>= fun conn ->
_assert (is_rejected conn) __LOC__ "" >>=? fun () -> _assert (is_rejected conn) __LOC__ "" >>=? fun () ->
return () return ()
@ -186,7 +186,7 @@ module Kicked = struct
let server _ch sched socket = let server _ch sched socket =
accept sched socket >>=? fun (_info, auth_fd) -> accept sched socket >>=? fun (_info, auth_fd) ->
P2p_socket.accept auth_fd encoding >>= fun conn -> P2p_socket.accept auth_fd () encoding >>= fun conn ->
_assert (Kick.is_rejected conn) __LOC__ "" >>=? fun () -> _assert (Kick.is_rejected conn) __LOC__ "" >>=? fun () ->
return () return ()
@ -208,7 +208,7 @@ module Simple_message = struct
let server ch sched socket = let server ch sched socket =
accept sched socket >>=? fun (_info, auth_fd) -> accept sched socket >>=? fun (_info, auth_fd) ->
P2p_socket.accept auth_fd encoding >>=? fun conn -> P2p_socket.accept auth_fd () encoding >>=? fun (conn, _ack_cfg) ->
P2p_socket.write_sync conn simple_msg >>=? fun () -> P2p_socket.write_sync conn simple_msg >>=? fun () ->
P2p_socket.read conn >>=? fun (_msg_size, msg) -> P2p_socket.read conn >>=? fun (_msg_size, msg) ->
_assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () -> _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () ->
@ -218,7 +218,7 @@ module Simple_message = struct
let client ch sched addr port = let client ch sched addr port =
connect sched addr port id2 >>=? fun auth_fd -> connect sched addr port id2 >>=? fun auth_fd ->
P2p_socket.accept auth_fd encoding >>=? fun conn -> P2p_socket.accept auth_fd () encoding >>=? fun (conn, _ack_cfg) ->
P2p_socket.write_sync conn simple_msg2 >>=? fun () -> P2p_socket.write_sync conn simple_msg2 >>=? fun () ->
P2p_socket.read conn >>=? fun (_msg_size, msg) -> P2p_socket.read conn >>=? fun (_msg_size, msg) ->
_assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () -> _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () ->
@ -240,7 +240,7 @@ module Chunked_message = struct
let server ch sched socket = let server ch sched socket =
accept sched socket >>=? fun (_info, auth_fd) -> accept sched socket >>=? fun (_info, auth_fd) ->
P2p_socket.accept P2p_socket.accept
~binary_chunks_size:21 auth_fd encoding >>=? fun conn -> ~binary_chunks_size:21 auth_fd () encoding >>=? fun (conn, _ack_cfg) ->
P2p_socket.write_sync conn simple_msg >>=? fun () -> P2p_socket.write_sync conn simple_msg >>=? fun () ->
P2p_socket.read conn >>=? fun (_msg_size, msg) -> P2p_socket.read conn >>=? fun (_msg_size, msg) ->
_assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () -> _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () ->
@ -251,7 +251,7 @@ module Chunked_message = struct
let client ch sched addr port = let client ch sched addr port =
connect sched addr port id2 >>=? fun auth_fd -> connect sched addr port id2 >>=? fun auth_fd ->
P2p_socket.accept P2p_socket.accept
~binary_chunks_size:21 auth_fd encoding >>=? fun conn -> ~binary_chunks_size:21 auth_fd () encoding >>=? fun (conn, _ack_cfg) ->
P2p_socket.write_sync conn simple_msg2 >>=? fun () -> P2p_socket.write_sync conn simple_msg2 >>=? fun () ->
P2p_socket.read conn >>=? fun (_msg_size, msg) -> P2p_socket.read conn >>=? fun (_msg_size, msg) ->
_assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () -> _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () ->
@ -272,7 +272,7 @@ module Oversized_message = struct
let server ch sched socket = let server ch sched socket =
accept sched socket >>=? fun (_info, auth_fd) -> accept sched socket >>=? fun (_info, auth_fd) ->
P2p_socket.accept auth_fd encoding >>=? fun conn -> P2p_socket.accept auth_fd () encoding >>=? fun (conn, _ack_cfg) ->
P2p_socket.write_sync conn simple_msg >>=? fun () -> P2p_socket.write_sync conn simple_msg >>=? fun () ->
P2p_socket.read conn >>=? fun (_msg_size, msg) -> P2p_socket.read conn >>=? fun (_msg_size, msg) ->
_assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () -> _assert (MBytes.compare simple_msg2 msg = 0) __LOC__ "" >>=? fun () ->
@ -282,7 +282,7 @@ module Oversized_message = struct
let client ch sched addr port = let client ch sched addr port =
connect sched addr port id2 >>=? fun auth_fd -> connect sched addr port id2 >>=? fun auth_fd ->
P2p_socket.accept auth_fd encoding >>=? fun conn -> P2p_socket.accept auth_fd () encoding >>=? fun (conn, _ack_cfg) ->
P2p_socket.write_sync conn simple_msg2 >>=? fun () -> P2p_socket.write_sync conn simple_msg2 >>=? fun () ->
P2p_socket.read conn >>=? fun (_msg_size, msg) -> P2p_socket.read conn >>=? fun (_msg_size, msg) ->
_assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () -> _assert (MBytes.compare simple_msg msg = 0) __LOC__ "" >>=? fun () ->
@ -302,14 +302,14 @@ module Close_on_read = struct
let server ch sched socket = let server ch sched socket =
accept sched socket >>=? fun (_info, auth_fd) -> accept sched socket >>=? fun (_info, auth_fd) ->
P2p_socket.accept auth_fd encoding >>=? fun conn -> P2p_socket.accept auth_fd () encoding >>=? fun (conn, _ack_cfg) ->
sync ch >>=? fun () -> sync ch >>=? fun () ->
P2p_socket.close conn >>= fun _stat -> P2p_socket.close conn >>= fun _stat ->
return () return ()
let client ch sched addr port = let client ch sched addr port =
connect sched addr port id2 >>=? fun auth_fd -> connect sched addr port id2 >>=? fun auth_fd ->
P2p_socket.accept auth_fd encoding >>=? fun conn -> P2p_socket.accept auth_fd () encoding >>=? fun (conn, _ack_cfg) ->
sync ch >>=? fun () -> sync ch >>=? fun () ->
P2p_socket.read conn >>= fun err -> P2p_socket.read conn >>= fun err ->
_assert (is_connection_closed err) __LOC__ "" >>=? fun () -> _assert (is_connection_closed err) __LOC__ "" >>=? fun () ->
@ -328,14 +328,14 @@ module Close_on_write = struct
let server ch sched socket = let server ch sched socket =
accept sched socket >>=? fun (_info, auth_fd) -> accept sched socket >>=? fun (_info, auth_fd) ->
P2p_socket.accept auth_fd encoding >>=? fun conn -> P2p_socket.accept auth_fd () encoding >>=? fun (conn, _ack_cfg) ->
P2p_socket.close conn >>= fun _stat -> P2p_socket.close conn >>= fun _stat ->
sync ch >>=? fun ()-> sync ch >>=? fun ()->
return () return ()
let client ch sched addr port = let client ch sched addr port =
connect sched addr port id2 >>=? fun auth_fd -> connect sched addr port id2 >>=? fun auth_fd ->
P2p_socket.accept auth_fd encoding >>=? fun conn -> P2p_socket.accept auth_fd () encoding >>=? fun (conn, _ack_cfg) ->
sync ch >>=? fun ()-> sync ch >>=? fun ()->
Lwt_unix.sleep 0.1 >>= fun () -> Lwt_unix.sleep 0.1 >>= fun () ->
P2p_socket.write_sync conn simple_msg >>= fun err -> P2p_socket.write_sync conn simple_msg >>= fun err ->
@ -365,7 +365,7 @@ module Garbled_data = struct
let server _ch sched socket = let server _ch sched socket =
accept sched socket >>=? fun (_info, auth_fd) -> accept sched socket >>=? fun (_info, auth_fd) ->
P2p_socket.accept auth_fd encoding >>=? fun conn -> P2p_socket.accept auth_fd () encoding >>=? fun (conn, _ack_cfg) ->
P2p_socket.raw_write_sync conn garbled_msg >>=? fun () -> P2p_socket.raw_write_sync conn garbled_msg >>=? fun () ->
P2p_socket.read conn >>= fun err -> P2p_socket.read conn >>= fun err ->
_assert (is_connection_closed err) __LOC__ "" >>=? fun () -> _assert (is_connection_closed err) __LOC__ "" >>=? fun () ->
@ -374,7 +374,7 @@ module Garbled_data = struct
let client _ch sched addr port = let client _ch sched addr port =
connect sched addr port id2 >>=? fun auth_fd -> connect sched addr port id2 >>=? fun auth_fd ->
P2p_socket.accept auth_fd encoding >>=? fun conn -> P2p_socket.accept auth_fd () encoding >>=? fun (conn, _ack_cfg) ->
P2p_socket.read conn >>= fun err -> P2p_socket.read conn >>= fun err ->
_assert (is_decoding_error err) __LOC__ "" >>=? fun () -> _assert (is_decoding_error err) __LOC__ "" >>=? fun () ->
P2p_socket.close conn >>= fun _stat -> P2p_socket.close conn >>= fun _stat ->

5
src/lib_shell/distributed_db.ml
View File

@ -8,10 +8,9 @@
(**************************************************************************) (**************************************************************************)
module Message = Distributed_db_message module Message = Distributed_db_message
module Metadata = Distributed_db_metadata
type p2p = (Message.t, Metadata.t) P2p.net type p2p = (Message.t, Peer_metadata.t, Connection_metadata.t) P2p.net
type connection = (Message.t, Metadata.t) P2p.connection type connection = (Message.t, Peer_metadata.t, Connection_metadata.t) P2p.connection
type 'a request_param = { type 'a request_param = {
data: 'a ; data: 'a ;

3
src/lib_shell/distributed_db.mli
View File

@ -15,9 +15,8 @@ type t
type db = t type db = t
module Message = Distributed_db_message module Message = Distributed_db_message
module Metadata = Distributed_db_metadata
type p2p = (Message.t, Metadata.t) P2p.net type p2p = (Message.t, Peer_metadata.t, Connection_metadata.t) P2p.net
val create: State.t -> p2p -> t val create: State.t -> p2p -> t
val state: db -> State.t val state: db -> State.t

18
src/lib_shell/node.ml
View File

@ -65,19 +65,31 @@ type t = {
shutdown: unit -> unit Lwt.t ; shutdown: unit -> unit Lwt.t ;
} }
let peer_metadata_cfg : _ P2p.peer_meta_config = {
peer_meta_encoding = Peer_metadata.encoding ;
peer_meta_initial = () ;
score = fun _ -> 0. ;
}
let connection_metadata_cfg : _ P2p.conn_meta_config = {
conn_meta_encoding = Peer_metadata.encoding ;
conn_meta_value = fun _ -> () ;
}
let init_p2p p2p_params = let init_p2p p2p_params =
match p2p_params with match p2p_params with
| None -> | None ->
lwt_log_notice "P2P layer is disabled" >>= fun () -> lwt_log_notice "P2P layer is disabled" >>= fun () ->
Error_monad.return (P2p.faked_network Distributed_db_metadata.cfg) return (P2p.faked_network peer_metadata_cfg)
| Some (config, limits) -> | Some (config, limits) ->
lwt_log_notice "bootstraping chain..." >>= fun () -> lwt_log_notice "bootstraping chain..." >>= fun () ->
P2p.create P2p.create
~config ~limits ~config ~limits
Distributed_db_metadata.cfg peer_metadata_cfg
connection_metadata_cfg
Distributed_db_message.cfg >>=? fun p2p -> Distributed_db_message.cfg >>=? fun p2p ->
Lwt.async (fun () -> P2p.maintain p2p) ; Lwt.async (fun () -> P2p.maintain p2p) ;
Error_monad.return p2p return p2p
type config = { type config = {
genesis: State.Chain.genesis ; genesis: State.Chain.genesis ;

4
src/lib_shell/distributed_db_metadata.ml → src/lib_shell_services/connection_metadata.ml
View File

@ -8,8 +8,4 @@
(**************************************************************************) (**************************************************************************)
type t = unit type t = unit
let initial = ()
let encoding = Data_encoding.empty let encoding = Data_encoding.empty
let score () = 0.
let cfg : _ P2p.meta_config = { encoding ; initial ; score }

4
src/lib_shell/distributed_db_metadata.mli → src/lib_shell_services/connection_metadata.mli
View File

@ -7,7 +7,7 @@
(* *) (* *)
(**************************************************************************) (**************************************************************************)
(** Tezos Shell - All the (persistent) metadata associated to a peer. *) (** All the metadata associated to a running connection. *)
type t = unit (* TODO *) type t = unit (* TODO *)
val cfg : t P2p.meta_config val encoding: t Data_encoding.t

11
src/lib_shell_services/peer_metadata.ml Normal file
View File

@ -0,0 +1,11 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
type t = unit
let encoding = Data_encoding.empty

13
src/lib_shell_services/peer_metadata.mli Normal file
View File

@ -0,0 +1,13 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* All rights reserved. No warranty, explicit or implicit, provided. *)
(* *)
(**************************************************************************)
(** All the (persistent) metadata associated to a peer. *)
type t = unit (* TODO *)
val encoding: t Data_encoding.t