1(*
2 * Copyright (C) 2006-2007 XenSource Ltd.
3 * Copyright (C) 2008      Citrix Ltd.
4 * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
5 * Author Thomas Gazagnaire <thomas.gazagnaire@eu.citrix.com>
6 *
7 * This program is free software; you can redistribute it and/or modify
8 * it under the terms of the GNU Lesser General Public License as published
9 * by the Free Software Foundation; version 2.1 only. with the special
10 * exception on linking described in file LICENSE.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 * GNU Lesser General Public License for more details.
16 *)
17
18let debug fmt = Logging.debug "connections" fmt
19
20type t = {
21	anonymous: (Unix.file_descr, Connection.t) Hashtbl.t;
22	domains: (int, Connection.t) Hashtbl.t;
23	ports: (Xeneventchn.t, Connection.t) Hashtbl.t;
24	mutable watches: (string, Connection.watch list) Trie.t;
25}
26
27let create () = {
28	anonymous = Hashtbl.create 37;
29	domains = Hashtbl.create 37;
30	ports = Hashtbl.create 37;
31	watches = Trie.create ()
32}
33
34let add_anonymous cons fd can_write =
35	let xbcon = Xenbus.Xb.open_fd fd in
36	let con = Connection.create xbcon None in
37	Hashtbl.add cons.anonymous (Xenbus.Xb.get_fd xbcon) con
38
39let add_domain cons dom =
40	let xbcon = Xenbus.Xb.open_mmap (Domain.get_interface dom) (fun () -> Domain.notify dom) in
41	let con = Connection.create xbcon (Some dom) in
42	Hashtbl.add cons.domains (Domain.get_id dom) con;
43	match Domain.get_port dom with
44	| Some p -> Hashtbl.add cons.ports p con;
45	| None -> ()
46
47let select ?(only_if = (fun _ -> true)) cons =
48	Hashtbl.fold (fun _ con (ins, outs) ->
49		if (only_if con) then (
50			let fd = Connection.get_fd con in
51			(fd :: ins,  if Connection.has_output con then fd :: outs else outs)
52		) else (ins, outs)
53	)
54	cons.anonymous ([], [])
55
56let find cons =
57	Hashtbl.find cons.anonymous
58
59let find_domain cons =
60	Hashtbl.find cons.domains
61
62let find_domain_by_port cons port =
63	Hashtbl.find cons.ports port
64
65let del_watches_of_con con watches =
66	match List.filter (fun w -> Connection.get_con w != con) watches with
67	| [] -> None
68	| ws -> Some ws
69
70let del_anonymous cons con =
71	try
72		Hashtbl.remove cons.anonymous (Connection.get_fd con);
73		cons.watches <- Trie.map (del_watches_of_con con) cons.watches;
74		Connection.close con
75	with exn ->
76		debug "del anonymous %s" (Printexc.to_string exn)
77
78let del_domain cons id =
79	try
80		let con = find_domain cons id in
81		Hashtbl.remove cons.domains id;
82		(match Connection.get_domain con with
83		 | Some d ->
84		   (match Domain.get_port d with
85		    | Some p -> Hashtbl.remove cons.ports p
86		    | None -> ())
87		 | None -> ());
88		cons.watches <- Trie.map (del_watches_of_con con) cons.watches;
89		Connection.close con
90	with exn ->
91		debug "del domain %u: %s" id (Printexc.to_string exn)
92
93let iter_domains cons fct =
94	Hashtbl.iter (fun k c -> fct c) cons.domains
95
96let iter_anonymous cons fct =
97	Hashtbl.iter (fun _ c -> fct c) cons.anonymous
98
99let iter cons fct =
100	iter_domains cons fct; iter_anonymous cons fct
101
102let has_more_work cons =
103	Hashtbl.fold
104		(fun id con acc ->
105		 if Connection.has_more_work con then con :: acc else acc)
106		cons.domains []
107
108let key_of_str path =
109	if path.[0] = '@'
110	then [path]
111	else "" :: Store.Path.to_string_list (Store.Path.of_string path)
112
113let key_of_path path =
114	"" :: Store.Path.to_string_list path
115
116let add_watch cons con path token =
117	let apath, watch = Connection.add_watch con path token in
118	let key = key_of_str apath in
119	let watches =
120 		if Trie.mem cons.watches key
121 		then Trie.find cons.watches key
122 		else []
123	in
124 	cons.watches <- Trie.set cons.watches key (watch :: watches);
125	watch
126
127let del_watch cons con path token =
128 	let apath, watch = Connection.del_watch con path token in
129 	let key = key_of_str apath in
130 	let watches = Utils.list_remove watch (Trie.find cons.watches key) in
131 	if watches = [] then
132		cons.watches <- Trie.unset cons.watches key
133 	else
134		cons.watches <- Trie.set cons.watches key watches;
135 	watch
136
137(* path is absolute *)
138let fire_watches cons path recurse =
139	let key = key_of_path path in
140	let path = Store.Path.to_string path in
141	let fire_watch _ = function
142		| None         -> ()
143		| Some watches -> List.iter (fun w -> Connection.fire_watch w path) watches
144	in
145	let fire_rec x = function
146		| None         -> ()
147		| Some watches ->
148			  List.iter (fun w -> Connection.fire_single_watch w) watches
149	in
150	Trie.iter_path fire_watch cons.watches key;
151	if recurse then
152		Trie.iter fire_rec (Trie.sub cons.watches key)
153
154let fire_spec_watches cons specpath =
155	iter cons (fun con ->
156		List.iter (fun w -> Connection.fire_single_watch w) (Connection.get_watches con specpath))
157
158let set_target cons domain target_domain =
159	let con = find_domain cons domain in
160	Connection.set_target con target_domain
161
162let number_of_transactions cons =
163	let res = ref 0 in
164	let aux con =
165		res := Connection.number_of_transactions con + !res
166	in
167	iter cons aux;
168	!res
169
170let stats cons =
171	let nb_ops_anon = ref 0
172	and nb_watchs_anon = ref 0
173	and nb_ops_dom = ref 0
174	and nb_watchs_dom = ref 0 in
175	iter_anonymous cons (fun con ->
176		let con_watchs, con_ops = Connection.stats con in
177		nb_ops_anon := !nb_ops_anon + con_ops;
178		nb_watchs_anon := !nb_watchs_anon + con_watchs;
179	);
180	iter_domains cons (fun con ->
181		let con_watchs, con_ops = Connection.stats con in
182		nb_ops_dom := !nb_ops_dom + con_ops;
183		nb_watchs_dom := !nb_watchs_dom + con_watchs;
184	);
185	(Hashtbl.length cons.anonymous, !nb_ops_anon, !nb_watchs_anon,
186	 Hashtbl.length cons.domains, !nb_ops_dom, !nb_watchs_dom)
187
188let debug cons =
189	let anonymous = Hashtbl.fold (fun _ con accu -> Connection.debug con :: accu) cons.anonymous [] in
190	let domains = Hashtbl.fold (fun _ con accu -> Connection.debug con :: accu) cons.domains [] in
191	String.concat "" (domains @ anonymous)
192