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
17type ops =
18{
19	directory: string -> string list;
20	read: string -> string;
21	readv: string -> string list -> string list;
22	write: string -> string -> unit;
23	writev: string -> (string * string) list -> unit;
24	mkdir: string -> unit;
25	rm: string -> unit;
26	getperms: string -> Xsraw.perms;
27	setperms: string -> Xsraw.perms -> unit;
28	setpermsv: string -> string list -> Xsraw.perms -> unit;
29}
30
31let get_operations tid xsh = {
32	directory = (fun path -> Xsraw.directory tid path xsh);
33	read = (fun path -> Xsraw.read tid path xsh);
34	readv = (fun dir vec -> Xsraw.readv tid dir vec xsh);
35	write = (fun path value -> Xsraw.write tid path value xsh);
36	writev = (fun dir vec -> Xsraw.writev tid dir vec xsh);
37	mkdir = (fun path -> Xsraw.mkdir tid path xsh);
38	rm = (fun path -> Xsraw.rm tid path xsh);
39	getperms = (fun path -> Xsraw.getperms tid path xsh);
40	setperms = (fun path perms -> Xsraw.setperms tid path perms xsh);
41	setpermsv = (fun dir vec perms -> Xsraw.setpermsv tid dir vec perms xsh);
42}
43
44let transaction xsh (f: ops -> 'a) : 'a =
45	let commited = ref false and result = ref None in
46	while not !commited
47	do
48		let tid = Xsraw.transaction_start xsh in
49		let t = get_operations tid xsh in
50
51		begin try
52			result := Some (f t)
53		with exn ->
54			ignore (Xsraw.transaction_end tid false xsh);
55			raise exn
56		end;
57		commited := Xsraw.transaction_end tid true xsh
58	done;
59	match !result with
60	| None        -> failwith "internal error in transaction"
61	| Some result -> result
62