Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 143 lines (114 sloc) 3.795 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (*
19 @author Adam Koprowski
20 **)
21
0d81e95 [cleanup] open: remove Base in libnet
Raja authored
22 (* depends *)
23 module List = BaseList
24 module String = BaseString
fccc685 Initial open-source release
MLstate authored
25
26 #<Debugvar:LIBNET_CLUSTER>
27
28 let (|>) = InfixOperator.(|>)
29
30 module Ux = Unix
31
32 (* FIXME, if we want to compact the messages sent over network, we
33 probably could do with less bits for machine id (char would
34 probably do, at least for Paxos) *)
35 type node_id = int
36
37 module NodeSet = IntSet
38 type nodeset = NodeSet.t
39
40 module NodeMap = IntMap
41 type 'a nodemap = 'a NodeMap.t
42
43 module NodeOrder = Abstr.IntOrder
44
45 type addr = Ux.sockaddr
46
47 type t =
48 { my_id : node_id option
49 ; cluster : addr NodeMap.t
50 }
51
52 exception MeUnknown
53 let me dc =
54 match dc.my_id with
55 | Some x -> x
56 | None-> raise MeUnknown
57
58 let get_addr dc id = NodeMap.find id dc.cluster
59
60 let sockaddr_to_string = function
61 | Unix.ADDR_INET (addr, p) -> Printf.sprintf "%s:%d" (Unix.string_of_inet_addr addr) p
62 | Unix.ADDR_UNIX addr -> Printf.sprintf "Unix:%s" addr
63
64 (* FIXME, this is no good, change the structure to index by addresses and find it with a simple lookup *)
65 let get_id dc addr =
66 let find_id nodeId node v =
67 if node = addr then begin
68 assert (v = -1);
69 nodeId
70 end else
71 v
72 in
73 match NodeMap.fold find_id dc.cluster (-1) with
74 | -1 -> failwith (Printf.sprintf "[Cluster] Unknown clunser ode... %s" (sockaddr_to_string addr))
75 | i -> i
76
77 let node_id_to_debug_string = string_of_int
78
79 let node_id_to_string dc node_id =
80 let addr = get_addr dc node_id in
81 Printf.sprintf "<%s %s>" ("#" ^ string_of_int node_id |> Terminal.strong) (NetAddr.string_of_sockaddr addr)
82
83 let node_id_to_debug_string = string_of_int
84
85 let init ?me others =
86 let addrs =
87 match me with
88 | Some x -> x::others
89 | None -> others
90 in
91 let all = List.sort Pervasives.compare addrs in
92 let my_sid =
93 match me with
94 | None -> None
95 | Some x -> List.findi ((=) x) all in
96 let n = List.length all in
97 assert (List.uniq all = all);
98 let sids = List.init n (fun i -> i) in
99 let servers = List.combine sids all in
100 let cluster = NodeMap.from_list servers in
101 let dc =
102 { my_id = my_sid
103 ; cluster = cluster
104 }
105 in
106 #<If>
107 let print_sid sid =
108 let s = Printf.sprintf " <%s>: %s\n" (node_id_to_debug_string sid) (node_id_to_string dc sid) in
109 if Some sid = my_sid then
110 Terminal.emph s
111 else
112 s
113 in
114 Logger.info "cluster initialized with %d servers:\n%s" n (String.concat_map "\n" print_sid (NodeMap.keys cluster));
115 #<End>;
116 dc
117
118 let all_server_ids ?(including_myself = true) dc =
119 let all = NodeMap.keys dc.cluster in
120 if including_myself then
121 all
122 else
123 match dc.my_id with
124 | None -> all
125 | Some x -> List.remove_all x all
126
127 let random_server_id ?including_myself dc =
128 let all = all_server_ids ?including_myself dc in
129 List.choose_random all
130
131 let servers_no ?including_myself dc =
132 List.length (all_server_ids ?including_myself dc)
133
134 let all_server_endpoints ?including_myself dc =
135 let ss = all_server_ids ?including_myself dc in
136 List.map (get_addr dc) ss
137
138 let node_id_to_int node_id = node_id
139
140 let label dc =
141 let id = string_of_int (me dc) in
142 "{Cluster@" ^ Terminal.strong id ^ "}"
Something went wrong with that request. Please try again.