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 _ 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 137let del_watches cons con = 138 Connection.del_watches con; 139 cons.watches <- Trie.map (del_watches_of_con con) cons.watches 140 141(* path is absolute *) 142let fire_watches ?oldroot root cons path recurse = 143 let key = key_of_path path in 144 let path = Store.Path.to_string path in 145 let roots = oldroot, root in 146 let fire_watch _ = function 147 | None -> () 148 | Some watches -> List.iter (fun w -> Connection.fire_watch roots w path) watches 149 in 150 let fire_rec _x = function 151 | None -> () 152 | Some watches -> 153 List.iter (Connection.fire_single_watch roots) watches 154 in 155 Trie.iter_path fire_watch cons.watches key; 156 if recurse then 157 Trie.iter fire_rec (Trie.sub cons.watches key) 158 159let fire_spec_watches root cons specpath = 160 iter cons (fun con -> 161 List.iter (Connection.fire_single_watch (None, root)) (Connection.get_watches con specpath)) 162 163let set_target cons domain target_domain = 164 let con = find_domain cons domain in 165 Connection.set_target con target_domain 166 167let number_of_transactions cons = 168 let res = ref 0 in 169 let aux con = 170 res := Connection.number_of_transactions con + !res 171 in 172 iter cons aux; 173 !res 174 175let stats cons = 176 let nb_ops_anon = ref 0 177 and nb_watchs_anon = ref 0 178 and nb_ops_dom = ref 0 179 and nb_watchs_dom = ref 0 in 180 iter_anonymous cons (fun con -> 181 let con_watchs, con_ops = Connection.stats con in 182 nb_ops_anon := !nb_ops_anon + con_ops; 183 nb_watchs_anon := !nb_watchs_anon + con_watchs; 184 ); 185 iter_domains cons (fun con -> 186 let con_watchs, con_ops = Connection.stats con in 187 nb_ops_dom := !nb_ops_dom + con_ops; 188 nb_watchs_dom := !nb_watchs_dom + con_watchs; 189 ); 190 (Hashtbl.length cons.anonymous, !nb_ops_anon, !nb_watchs_anon, 191 Hashtbl.length cons.domains, !nb_ops_dom, !nb_watchs_dom) 192 193let debug cons = 194 let anonymous = Hashtbl.fold (fun _ con accu -> Connection.debug con :: accu) cons.anonymous [] in 195 let domains = Hashtbl.fold (fun _ con accu -> Connection.debug con :: accu) cons.domains [] in 196 String.concat "" (domains @ anonymous) 197