(* * Copyright (C) 2006-2007 XenSource Ltd. * Copyright (C) 2008 Citrix Ltd. * Author Vincent Hanquez * Author Thomas Gazagnaire * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published * by the Free Software Foundation; version 2.1 only. with the special * exception on linking described in file LICENSE. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. *) let debug fmt = Logging.debug "connections" fmt type t = { mutable anonymous: Connection.t list; domains: (int, Connection.t) Hashtbl.t; mutable watches: (string, Connection.watch list) Trie.t; } let create () = { anonymous = []; domains = Hashtbl.create 8; watches = Trie.create () } let add_anonymous cons fd can_write = let xbcon = Xenbus.Xb.open_fd fd in let con = Connection.create xbcon None in cons.anonymous <- con :: cons.anonymous let add_domain cons dom = let xbcon = Xenbus.Xb.open_mmap (Domain.get_interface dom) (fun () -> Domain.notify dom) in let con = Connection.create xbcon (Some dom) in Hashtbl.add cons.domains (Domain.get_id dom) con let select cons = let inset = List.map (fun c -> Connection.get_fd c) cons.anonymous and outset = List.fold_left (fun l c -> if Connection.has_output c then Connection.get_fd c :: l else l) [] cons.anonymous in inset, outset let find cons fd = List.find (fun c -> Connection.get_fd c = fd) cons.anonymous let find_domain cons id = Hashtbl.find cons.domains id let del_watches_of_con con watches = match List.filter (fun w -> Connection.get_con w != con) watches with | [] -> None | ws -> Some ws let del_anonymous cons con = try cons.anonymous <- Utils.list_remove con cons.anonymous; cons.watches <- Trie.map (del_watches_of_con con) cons.watches; Connection.close con with exn -> debug "del anonymous %s" (Printexc.to_string exn) let del_domain cons id = try let con = find_domain cons id in Hashtbl.remove cons.domains id; cons.watches <- Trie.map (del_watches_of_con con) cons.watches; Connection.close con with exn -> debug "del domain %u: %s" id (Printexc.to_string exn) let iter_domains cons fct = Hashtbl.iter (fun k c -> fct c) cons.domains let iter_anonymous cons fct = List.iter (fun c -> fct c) (List.rev cons.anonymous) let iter cons fct = iter_domains cons fct; iter_anonymous cons fct let has_more_work cons = Hashtbl.fold (fun id con acc -> if Connection.has_more_input con then con :: acc else acc) cons.domains [] let key_of_str path = if path.[0] = '@' then [path] else "" :: Store.Path.to_string_list (Store.Path.of_string path) let key_of_path path = "" :: Store.Path.to_string_list path let add_watch cons con path token = let apath, watch = Connection.add_watch con path token in let key = key_of_str apath in let watches = if Trie.mem cons.watches key then Trie.find cons.watches key else [] in cons.watches <- Trie.set cons.watches key (watch :: watches); watch let del_watch cons con path token = let apath, watch = Connection.del_watch con path token in let key = key_of_str apath in let watches = Utils.list_remove watch (Trie.find cons.watches key) in if watches = [] then cons.watches <- Trie.unset cons.watches key else cons.watches <- Trie.set cons.watches key watches; watch (* path is absolute *) let fire_watches cons path recurse = let key = key_of_path path in let path = Store.Path.to_string path in let fire_watch _ = function | None -> () | Some watches -> List.iter (fun w -> Connection.fire_watch w path) watches in let fire_rec x = function | None -> () | Some watches -> List.iter (fun w -> Connection.fire_single_watch w) watches in Trie.iter_path fire_watch cons.watches key; if recurse then Trie.iter fire_rec (Trie.sub cons.watches key) let fire_spec_watches cons specpath = iter cons (fun con -> List.iter (fun w -> Connection.fire_single_watch w) (Connection.get_watches con specpath)) let set_target cons domain target_domain = let con = find_domain cons domain in Connection.set_target con target_domain let number_of_transactions cons = let res = ref 0 in let aux con = res := Connection.number_of_transactions con + !res in iter cons aux; !res let stats cons = let nb_ops_anon = ref 0 and nb_watchs_anon = ref 0 and nb_ops_dom = ref 0 and nb_watchs_dom = ref 0 in iter_anonymous cons (fun con -> let con_watchs, con_ops = Connection.stats con in nb_ops_anon := !nb_ops_anon + con_ops; nb_watchs_anon := !nb_watchs_anon + con_watchs; ); iter_domains cons (fun con -> let con_watchs, con_ops = Connection.stats con in nb_ops_dom := !nb_ops_dom + con_ops; nb_watchs_dom := !nb_watchs_dom + con_watchs; ); (List.length cons.anonymous, !nb_ops_anon, !nb_watchs_anon, Hashtbl.length cons.domains, !nb_ops_dom, !nb_watchs_dom) let debug cons = let anonymous = List.map Connection.debug cons.anonymous in let domains = Hashtbl.fold (fun _ con accu -> Connection.debug con :: accu) cons.domains [] in String.concat "" (domains @ anonymous)