From 4ded0660d670f47377c1ac98659ce236c47dc659 Mon Sep 17 00:00:00 2001
From: OCamlPro-Iguernlala <mohamed.iguernlala@ocamlpro.com>
Date: Tue, 18 Apr 2017 18:13:46 +0200
Subject: [PATCH] p2p: check values of some options in P2p.create

---
 src/node/net/p2p.ml    | 39 ++++++++++++++++++++++++++++++++++++---
 src/node/net/p2p.mli   |  2 +-
 src/node/shell/node.ml |  8 ++++----
 3 files changed, 41 insertions(+), 8 deletions(-)

diff --git a/src/node/net/p2p.ml b/src/node/net/p2p.ml
index 10348749a..c7975ca48 100644
--- a/src/node/net/p2p.ml
+++ b/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 ->
-  Lwt.return {
+  check_limits limits >>=? fun () ->
+  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  ;
diff --git a/src/node/net/p2p.mli b/src/node/net/p2p.mli
index a8547bf77..5d78a85a7 100644
--- a/src/node/net/p2p.mli
+++ b/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
diff --git a/src/node/shell/node.ml b/src/node/shell/node.ml
index 9bbd77e13..401562e0a 100644
--- a/src/node/shell/node.ml
+++ b/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