Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

120 lines (97 sloc) 3.493 kB
(*
Copyright © 2011 MLstate
This file is part of OPA.
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
*)
(*
@author Adam Koprowski
**)
#<Debugvar:LIBNET_CLUSTER>
let (|>) = InfixOperator.(|>)
module Sched = Scheduler
module Ux = Unix
module NA = NetAddr
type connection = Sched.connection_info
type ('out', 'in') t =
{ cluster : Cluster.t
; sched : Scheduler.t
; conn : connection
}
type addr = Unix.sockaddr
let get_inet_addr = function
| Ux.ADDR_UNIX _ -> failwith "[Cluster] cannot use local Unix file descriptors to initialize a cluster"
| Ux.ADDR_INET (addr, _port) -> addr
let get_port = function
| Ux.ADDR_UNIX _ -> failwith "[Cluster] cannot use local Unix file descriptors to initialize a cluster"
| Ux.ADDR_INET (_addr, port) -> port
let init_from ~protocol sched cluster =
let connection =
let make_sched_connection fd addr =
let addr = NA.mk_udp ~protocol ~fd ~addr in
Scheduler.make_connection sched addr
in
let me =
try
Cluster.me cluster |> Cluster.get_addr cluster
with
Cluster.MeUnknown-> Ux.ADDR_INET (Unix.inet_addr_any, 0)
in
let listen_addr = Ux.ADDR_INET (Unix.inet_addr_any, get_port me) in
let socket = Connection.listen ~socket_type:Connection.UDP listen_addr in
make_sched_connection socket (get_inet_addr me)
in
let dc =
{ cluster = cluster
; conn = connection
; sched = sched
}
in
dc
let init ~protocol sched ?me others =
let cluster = Cluster.init ?me others in
init_from ~protocol sched cluster
let register_msg_handler dc msg_handler =
let rec read_one () = Scheduler.read_from dc.sched dc.conn callback
and callback (_, addr, msg_str) =
let msg = Marshal.from_string msg_str 0 in
(* let nodeId = Cluster.get_id cluster addr in*)
read_one ();
#<If> Logger.debug "%s processing response from %s\n%!" (Cluster.label dc.cluster) (NA.string_of_sockaddr addr) #<End>;
msg_handler dc addr msg
in
read_one ()
let get_cluster dc =
dc.cluster
let close dc =
Scheduler.remove_connection dc.sched dc.conn
let send_to_aux dc remote_addr v k =
let msg = Marshal.to_string v [] in
Scheduler.write_to dc.sched dc.conn remote_addr msg (fun _ -> k ())
let send_to dc remote_addr v k =
#<If> Logger.debug "%s Sending msg to %s\n%!" (Cluster.label dc.cluster) (NA.string_of_sockaddr remote_addr) #<End>;
send_to_aux dc remote_addr v k
let send dc id v k =
let remote_addr = Cluster.get_addr dc.cluster id in
#<If> Logger.debug "%s Sending msg to %s\n%!" (Cluster.label dc.cluster) (Cluster.node_id_to_string dc.cluster id) #<End>;
send_to_aux dc remote_addr v k
let broadcast ?(including_myself = true) dc v k =
let rec send_all = function
| [] -> ()
| id::ids ->
let k =
match ids with
| [] -> k
| _ -> fun _ -> ()
in
send dc id v k;
send_all ids
in
send_all (Cluster.all_server_ids ~including_myself dc.cluster)
Jump to Line
Something went wrong with that request. Please try again.