1(* 2 * Copyright (C) 2006-2007 XenSource Ltd. 3 * Copyright (C) 2008 Citrix Ltd. 4 * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> 5 * 6 * This program is free software; you can redistribute it and/or modify 7 * it under the terms of the GNU Lesser General Public License as published 8 * by the Free Software Foundation; version 2.1 only. with the special 9 * exception on linking described in file LICENSE. 10 * 11 * This program is distributed in the hope that it will be useful, 12 * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 * GNU Lesser General Public License for more details. 15 *) 16 17exception Limit_reached 18exception Data_too_big 19exception Transaction_opened 20 21let warn fmt = Logging.warn "quota" fmt 22let activate = ref true 23let maxent = ref (10000) 24let maxsize = ref (4096) 25 26type t = { 27 maxent: int; (* max entities per domU *) 28 maxsize: int; (* max size of data store in one node *) 29 cur: (Xenctrl.domid, int) Hashtbl.t; (* current domains quota *) 30} 31 32let to_string quota domid = 33 if Hashtbl.mem quota.cur domid 34 then Printf.sprintf "dom%i quota: %i/%i" domid (Hashtbl.find quota.cur domid) quota.maxent 35 else Printf.sprintf "dom%i quota: not set" domid 36 37let create () = 38 { maxent = !maxent; maxsize = !maxsize; cur = Hashtbl.create 100; } 39 40let copy quota = { quota with cur = (Hashtbl.copy quota.cur) } 41 42let del quota id = Hashtbl.remove quota.cur id 43 44let _check quota id size = 45 if size > quota.maxsize then ( 46 warn "domain %u err create entry: data too big %d" id size; 47 raise Data_too_big 48 ); 49 if id > 0 && Hashtbl.mem quota.cur id then 50 let entry = Hashtbl.find quota.cur id in 51 if entry >= quota.maxent then ( 52 warn "domain %u cannot create entry: quota reached" id; 53 raise Limit_reached 54 ) 55 56let check quota id size = 57 if !activate then 58 _check quota id size 59 60let get_entry quota id = Hashtbl.find quota.cur id 61 62let set_entry quota id nb = 63 if nb = 0 64 then Hashtbl.remove quota.cur id 65 else begin 66 if Hashtbl.mem quota.cur id then 67 Hashtbl.replace quota.cur id nb 68 else 69 Hashtbl.add quota.cur id nb 70 end 71 72let del_entry quota id = 73 try 74 let nb = get_entry quota id in 75 set_entry quota id (nb - 1) 76 with Not_found -> () 77 78let add_entry quota id = 79 let nb = try get_entry quota id with Not_found -> 0 in 80 set_entry quota id (nb + 1) 81 82let add quota diff = 83 Hashtbl.iter (fun id nb -> set_entry quota id (get_entry quota id + nb)) diff.cur 84 85let merge orig_quota mod_quota dest_quota = 86 Hashtbl.iter (fun id nb -> let diff = nb - (try get_entry orig_quota id with Not_found -> 0) in 87 if diff <> 0 then 88 set_entry dest_quota id ((try get_entry dest_quota id with Not_found -> 0) + diff)) mod_quota.cur 89