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