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
17let enable = ref false
18let xs_daemon_database = Paths.xen_run_stored ^ "/db"
19
20let error fmt = Logging.error "disk" fmt
21
22(* unescape utils *)
23exception Bad_escape
24
25let is_digit c = match c with '0' .. '9' -> true | _ -> false
26
27let undec c =
28	match c with
29	| '0' .. '9' -> (Char.code c) - (Char.code '0')
30	| _          -> raise (Failure "undecify")
31
32let unhex c =
33	let c = Char.lowercase c in
34	match c with
35	| '0' .. '9' -> (Char.code c) - (Char.code '0')
36	| 'a' .. 'f' -> (Char.code c) - (Char.code 'a') + 10
37	| _          -> raise (Failure "unhexify")
38
39let string_unescaped s =
40	let len = String.length s
41	and i = ref 0 in
42	let d = Buffer.create len in
43
44	let read_escape () =
45		incr i;
46		match s.[!i] with
47		| 'n'  -> '\n'
48		| 'r'  -> '\r'
49		| '\\' -> '\\'
50		| '\'' -> '\''
51		| '"'  -> '"'
52		| 't'  -> '\t'
53		| 'b'  -> '\b'
54		| 'x'  ->
55			let v = (unhex s.[!i + 1] * 16) + unhex s.[!i + 2] in
56			i := !i + 2;
57			Char.chr v
58		| c    ->
59			if is_digit c then (
60				let v = (undec s.[!i]) * 100 +
61					(undec s.[!i + 1]) * 10 +
62					(undec s.[!i + 2]) in
63				i := !i + 2;
64				Char.chr v
65			) else
66				raise Bad_escape
67	in
68
69	while !i < len
70	do
71		let c = match s.[!i] with
72		| '\\' -> read_escape ()
73		| c    -> c in
74		Buffer.add_char d c;
75		incr i
76	done;
77	Buffer.contents d
78
79(* file -> lines_of_file *)
80let file_readlines file =
81	let channel = open_in file in
82	let rec input_line_list channel =
83		let line = try input_line channel with End_of_file -> "" in
84		if String.length line > 0 then
85			line :: input_line_list channel
86		else (
87			close_in channel;
88			[]
89		) in
90	input_line_list channel
91
92let rec map_string_list_range l s =
93	match l with
94	| [] -> []
95	| (a,b) :: l -> String.sub s a (b - a) :: map_string_list_range l s
96
97let is_digit c =
98	try ignore (int_of_char c); true with _ -> false
99
100let rec parse_perm s =
101	let len = String.length s in
102	if len = 0 then
103		[]
104	else
105		let i = ref 1 in
106		while !i < len && is_digit s.[!i] do incr i done;
107		let x = String.sub s 0 !i
108		and lx = String.sub s !i len in
109		x :: parse_perm lx
110
111let read store =
112	(* don't let the permission get on our way, full perm ! *)
113	let v = Store.get_ops store Perms.Connection.full_rights in
114
115	(* a line is : path{perm} or path{perm} = value *)
116	let parse_line s =
117		let path, perm, value =
118			let len = String.length s in
119			let si = if String.contains s '=' then
120					String.index s '='
121				else
122					len - 1 in
123			let pi = String.rindex_from s si '{' in
124			let epi = String.index_from s pi '}' in
125
126			if String.contains s '=' then
127				let ss = map_string_list_range [ (0, pi);
128				                                 (pi + 1, epi);
129				                                 (si + 2, len); ] s in
130				(List.nth ss 0, List.nth ss 1, List.nth ss 2)
131			else
132				let ss = map_string_list_range [ (0, pi);
133				                                 (pi + 1, epi);
134				                               ] s in
135				(List.nth ss 0, List.nth ss 1, "")
136			in
137		let path = Store.Path.of_string path in
138		v.Store.write path (string_unescaped value);
139		v.Store.setperms path (Perms.Node.of_strings (parse_perm perm)) in
140	try
141		let lines = file_readlines xs_daemon_database in
142		List.iter (fun s -> parse_line s) lines
143	with exc ->
144		error "caught exn %s" (Printexc.to_string exc)
145
146let write store =
147	if !enable then
148	try
149		let tfile = Printf.sprintf "%s#" xs_daemon_database in
150		let channel = open_out_gen [ Open_wronly; Open_creat; Open_trunc; ]
151		                           0o600 tfile in
152		Store.dump store channel;
153		flush channel;
154		close_out channel;
155		Unix.rename tfile xs_daemon_database
156	with exc ->
157		error "caught exn %s" (Printexc.to_string exc)
158