p2p: check values of some options in P2p.create

src/node/net/p2p.ml

@@ -168,7 +168,7 @@ module Real = struct
     let discoverer = may_create_discovery_worker config pool in
     let maintenance = create_maintenance_worker limits pool discoverer in
     may_create_welcome_worker config limits pool >>= fun welcome ->
-    Lwt.return {
+    return {
       config ;
       limits ;
       io_sched ;
@@ -335,9 +335,42 @@ type ('msg, 'meta) t = {
 }
 type ('msg, 'meta) net = ('msg, 'meta) t
 
+let check_limits =
+  let fail_1 v orig =
+    if not (v <= 0.) then return ()
+    else
+      Error_monad.failwith "value of option %S cannot be negative or null@."
+        orig
+  in
+  let fail_2 v orig =
+    if not (v < 0) then return ()
+    else
+      Error_monad.failwith "value of option %S cannot be negative@." orig
+  in
+  fun c ->
+    fail_1 c.authentification_timeout
+      "authentification-timeout" >>=? fun () ->
+    fail_2 c.min_connections
+      "min-connections" >>=? fun () ->
+    fail_2 c.expected_connections
+      "expected-connections" >>=? fun () ->
+    fail_2 c.max_connections
+      "max-connections" >>=? fun () ->
+    fail_2 c.max_incoming_connections
+      "max-incoming-connections" >>=? fun () ->
+    fail_2 c.read_buffer_size
+      "read-buffer-size" >>=? fun () ->
+    fail_2 c.known_peer_ids_history_size
+      "known-peer-ids-history-size" >>=? fun () ->
+    fail_2 c.known_points_history_size
+      "known-points-history-size" >>=? fun () ->
+    fail_1 c.swap_linger
+      "swap-linger"
+
 let create ~config ~limits meta_cfg msg_cfg =
-  Real.create ~config ~limits meta_cfg msg_cfg  >>= fun net ->
+  check_limits limits >>=? fun () ->
-  Lwt.return {
+  Real.create ~config ~limits meta_cfg msg_cfg  >>=? fun net ->
+  return {
     peer_id = Real.peer_id net ;
     maintain = Real.maintain net ;
     roll = Real.roll net  ;

src/node/net/p2p.mli

@@ -139,7 +139,7 @@ val faked_network : 'meta meta_config -> ('msg, 'meta) net
 (** Main network initialisation function *)
 val create :
   config:config -> limits:limits ->
-  'meta meta_config -> 'msg message_config ->  ('msg, 'meta) net Lwt.t
+  'meta meta_config -> 'msg message_config ->  ('msg, 'meta) net tzresult Lwt.t
 
 (** Return one's peer_id *)
 val peer_id : ('msg, 'meta) net -> Peer_id.t

src/node/shell/node.ml

@@ -73,15 +73,15 @@ let init_p2p net_params =
   match net_params with
   | None ->
       lwt_log_notice "P2P layer is disabled" >>= fun () ->
-      Lwt.return (P2p.faked_network Distributed_db_metadata.cfg)
+      Error_monad.return (P2p.faked_network Distributed_db_metadata.cfg)
   | Some (config, limits) ->
       lwt_log_notice "bootstraping network..." >>= fun () ->
       P2p.create
         ~config ~limits
         Distributed_db_metadata.cfg
-        Distributed_db_message.cfg >>= fun p2p ->
+        Distributed_db_message.cfg >>=? fun p2p ->
       Lwt.async (fun () -> P2p.maintain p2p) ;
-      Lwt.return p2p
+      Error_monad.return p2p
 
 type config = {
   genesis: State.Net.genesis ;
@@ -102,7 +102,7 @@ let may_create_net state genesis =
 let create { genesis ; store_root ; context_root ;
              patch_context ; p2p = net_params ;
              test_network_max_tll = max_ttl } =
-  init_p2p net_params >>= fun p2p ->
+  init_p2p net_params >>=? fun p2p ->
   State.read
     ~store_root ~context_root ?patch_context () >>=? fun state ->
   let distributed_db = Distributed_db.create state p2p in