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

Shell: fix warnings in p2p.ml.

Browse Source
This commit is contained in:
Benjamin Canou 2016-09-15 15:47:27 +02:00
parent c1079c78e4
commit 20d78e70e9
1 changed files with 24 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
src/node/net/p2p.ml
View File

@ -241,7 +241,7 @@ end = struct
let remove_by_point point ({ by_point ; by_gid } as map) = let remove_by_point point ({ by_point ; by_gid } as map) =
try try
let (gid, v) = PointMap.find point by_point in let (gid, _) = PointMap.find point by_point in
{ by_point = PointMap.remove point by_point ; { by_point = PointMap.remove point by_point ;
by_gid = match gid with by_gid = match gid with
| None -> by_gid | None -> by_gid
@ -495,9 +495,13 @@ let answerable_discovery_message message my_gid when_ok when_not =
else when_not () else when_not ()
| _ -> when_not () | _ -> when_not ()
let string_of_unix_exn = function
| Unix.Unix_error (err, fn, _) -> "in " ^ fn ^ ", " ^ Unix.error_message err
| exn -> Printexc.to_string exn
(* Launch an answer machine for the discovery mechanism, takes a (* Launch an answer machine for the discovery mechanism, takes a
callback to fill the answers and returns a canceler function *) callback to fill the answers and returns a canceler function *)
let discovery_answerer config limits my_gid disco_port cancelation callback = let discovery_answerer my_gid disco_port cancelation callback =
(* init a UDP listening socket on the broadcast canal *) (* init a UDP listening socket on the broadcast canal *)
catch catch
(fun () -> (fun () ->
@ -506,11 +510,11 @@ let discovery_answerer config limits my_gid disco_port cancelation callback =
LU.(setsockopt main_socket SO_REUSEADDR true) ; LU.(setsockopt main_socket SO_REUSEADDR true) ;
LU.(bind main_socket (ADDR_INET (Unix.inet_addr_any, disco_port))) ; LU.(bind main_socket (ADDR_INET (Unix.inet_addr_any, disco_port))) ;
return (Some main_socket)) return (Some main_socket))
(fun exn -> return None) >>= function (fun exn ->
| None -> debug "(%a) will not listen to discovery requests (%s)"
debug "(%a) will not listen to discovery requests (port taken or closed)" pp_gid my_gid (string_of_unix_exn exn) ;
pp_gid my_gid ; return None) >>= function
return () | None -> return ()
| Some main_socket -> | Some main_socket ->
(* the answering function *) (* the answering function *)
let rec step () = let rec step () =
@ -524,7 +528,7 @@ let discovery_answerer config limits my_gid disco_port cancelation callback =
step () (* drop bytes, better luck next time ! *) step () (* drop bytes, better luck next time ! *)
else else
answerable_discovery_message (Netbits.of_raw buffer) my_gid answerable_discovery_message (Netbits.of_raw buffer) my_gid
(fun gid port -> (fun _ port ->
catch catch
(fun () -> (fun () ->
let socket = LU.(socket PF_INET SOCK_STREAM 0) in let socket = LU.(socket PF_INET SOCK_STREAM 0) in
@ -542,7 +546,7 @@ let discovery_answerer config limits my_gid disco_port cancelation callback =
(* Sends dicover messages into space in an exponentially delayed loop, (* Sends dicover messages into space in an exponentially delayed loop,
restartable using a condition *) restartable using a condition *)
let discovery_sender config limits my_gid disco_port inco_port cancelation restart = let discovery_sender my_gid disco_port inco_port cancelation restart =
let message = discovery_message my_gid inco_port in let message = discovery_message my_gid inco_port in
let rec loop delay n = let rec loop delay n =
catch catch
@ -687,8 +691,8 @@ let bootstrap config limits =
LU.listen main_socket limits.max_connections ; LU.listen main_socket limits.max_connections ;
return (Some main_socket)) return (Some main_socket))
(fun exn -> (fun exn ->
debug "(%a) cannot accept incoming peers (port taken or closed)" debug "(%a) cannot accept incoming peers (%s)"
pp_gid my_gid ; pp_gid my_gid (string_of_unix_exn exn) ;
return None)>>= function return None)>>= function
| None -> | None ->
(* FIXME: run in degraded mode, better exit ? *) (* FIXME: run in degraded mode, better exit ? *)
@ -762,7 +766,7 @@ let bootstrap config limits =
let uaddr = Ipaddr_unix.to_inet_addr addr in let uaddr = Ipaddr_unix.to_inet_addr addr in
catch catch
(fun () -> (fun () ->
lwt_debug "Trying connection to %a:%d" lwt_debug "Trying to connect to %a:%d"
Ipaddr.pp_hum addr port >>= fun () -> Ipaddr.pp_hum addr port >>= fun () ->
Lwt.pick Lwt.pick
[ (Lwt_unix.sleep 2.0 >>= fun _ -> Lwt.fail Not_found) ; [ (Lwt_unix.sleep 2.0 >>= fun _ -> Lwt.fail Not_found) ;
@ -772,9 +776,10 @@ let bootstrap config limits =
Ipaddr.pp_hum addr port >>= fun () -> Ipaddr.pp_hum addr port >>= fun () ->
enqueue_event (Contact ((addr, port), socket)) ; enqueue_event (Contact ((addr, port), socket)) ;
return (nb - 1)) return (nb - 1))
(fun e -> (fun exn ->
lwt_debug "Connection failed to %a:%d" lwt_debug "Connection failed to %a:%d (%s)"
Ipaddr.pp_hum addr port >>= fun () -> Ipaddr.pp_hum addr port
(string_of_unix_exn exn) >>= fun () ->
(* if we didn't succes, we greylist it *) (* if we didn't succes, we greylist it *)
let now = Unix.gettimeofday () in let now = Unix.gettimeofday () in
known_peers := known_peers :=
@ -810,7 +815,7 @@ let bootstrap config limits =
let to_kill = n_connected - limits.max_connections in let to_kill = n_connected - limits.max_connections in
debug "(%a) too many connections, will kill %d" pp_gid my_gid to_kill ; debug "(%a) too many connections, will kill %d" pp_gid my_gid to_kill ;
snd (PeerMap.fold snd (PeerMap.fold
(fun lid _ peer (i, t) -> (fun _ _ peer (i, t) ->
if i = 0 then (0, t) if i = 0 then (0, t)
else (i - 1, t >>= fun () -> peer.disconnect ())) else (i - 1, t >>= fun () -> peer.disconnect ()))
!connected (to_kill, return ())) >>= fun () -> !connected (to_kill, return ())) >>= fun () ->
@ -970,7 +975,7 @@ let bootstrap config limits =
match config.discovery_port with match config.discovery_port with
| Some disco_port -> | Some disco_port ->
let answerer () = let answerer () =
discovery_answerer config limits my_gid disco_port cancelation @@ fun addr port socket -> discovery_answerer my_gid disco_port cancelation @@ fun addr port socket ->
(* do not reply to ourselves or conncted peers *) (* do not reply to ourselves or conncted peers *)
if not (PeerMap.mem_by_point (addr, port) !connected) if not (PeerMap.mem_by_point (addr, port) !connected)
&& (try match PeerMap.gid_by_point (addr, port) !known_peers with && (try match PeerMap.gid_by_point (addr, port) !known_peers with
@ -993,7 +998,7 @@ let bootstrap config limits =
match config.incoming_port, config.discovery_port with match config.incoming_port, config.discovery_port with
| Some inco_port, Some disco_port -> | Some inco_port, Some disco_port ->
let sender () = let sender () =
discovery_sender config limits my_gid disco_port inco_port cancelation restart_discovery in discovery_sender my_gid disco_port inco_port cancelation restart_discovery in
worker (Format.asprintf "(%a) discovery sender" pp_gid my_gid) sender cancel worker (Format.asprintf "(%a) discovery sender" pp_gid my_gid) sender cancel
| _ -> return () in | _ -> return () in
(* net manipulation callbacks *) (* net manipulation callbacks *)
@ -1100,7 +1105,7 @@ let faked_network =
let send_to _ = Lwt.return_unit in let send_to _ = Lwt.return_unit in
let push _ = () in let push _ = () in
let broadcast _ = () in let broadcast _ = () in
let blacklist ?duration _ = () in let blacklist ?duration _ = ignore duration ; () in
let whitelist _ = () in let whitelist _ = () in
let maintain () = Lwt.return_unit in let maintain () = Lwt.return_unit in
let roll () = Lwt.return_unit in let roll () = Lwt.return_unit in