1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
(*
* Copyright (C) 2006-2007 XenSource Ltd.
* Copyright (C) 2008 Citrix Ltd.
* Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published
* by the Free Software Foundation; version 2.1 only. with the special
* exception on linking described in file LICENSE.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*)
let enable = ref false
let xs_daemon_database = "/var/run/xenstored/db"
let error fmt = Logging.error "disk" fmt
(* unescape utils *)
exception Bad_escape
let is_digit c = match c with '0' .. '9' -> true | _ -> false
let undec c =
match c with
| '0' .. '9' -> (Char.code c) - (Char.code '0')
| _ -> raise (Failure "undecify")
let unhex c =
let c = Char.lowercase c in
match c with
| '0' .. '9' -> (Char.code c) - (Char.code '0')
| 'a' .. 'f' -> (Char.code c) - (Char.code 'a') + 10
| _ -> raise (Failure "unhexify")
let string_unescaped s =
let len = String.length s
and i = ref 0 in
let d = Buffer.create len in
let read_escape () =
incr i;
match s.[!i] with
| 'n' -> '\n'
| 'r' -> '\r'
| '\\' -> '\\'
| '\'' -> '\''
| '"' -> '"'
| 't' -> '\t'
| 'b' -> '\b'
| 'x' ->
let v = (unhex s.[!i + 1] * 16) + unhex s.[!i + 2] in
i := !i + 2;
Char.chr v
| c ->
if is_digit c then (
let v = (undec s.[!i]) * 100 +
(undec s.[!i + 1]) * 10 +
(undec s.[!i + 2]) in
i := !i + 2;
Char.chr v
) else
raise Bad_escape
in
while !i < len
do
let c = match s.[!i] with
| '\\' -> read_escape ()
| c -> c in
Buffer.add_char d c;
incr i
done;
Buffer.contents d
(* file -> lines_of_file *)
let file_readlines file =
let channel = open_in file in
let rec input_line_list channel =
let line = try input_line channel with End_of_file -> "" in
if String.length line > 0 then
line :: input_line_list channel
else (
close_in channel;
[]
) in
input_line_list channel
let rec map_string_list_range l s =
match l with
| [] -> []
| (a,b) :: l -> String.sub s a (b - a) :: map_string_list_range l s
let is_digit c =
try ignore (int_of_char c); true with _ -> false
let rec parse_perm s =
let len = String.length s in
if len = 0 then
[]
else
let i = ref 1 in
while !i < len && is_digit s.[!i] do incr i done;
let x = String.sub s 0 !i
and lx = String.sub s !i len in
x :: parse_perm lx
let read store =
(* don't let the permission get on our way, full perm ! *)
let v = Store.get_ops store Perms.Connection.full_rights in
(* a line is : path{perm} or path{perm} = value *)
let parse_line s =
let path, perm, value =
let len = String.length s in
let si = if String.contains s '=' then
String.index s '='
else
len - 1 in
let pi = String.rindex_from s si '{' in
let epi = String.index_from s pi '}' in
if String.contains s '=' then
let ss = map_string_list_range [ (0, pi);
(pi + 1, epi);
(si + 2, len); ] s in
(List.nth ss 0, List.nth ss 1, List.nth ss 2)
else
let ss = map_string_list_range [ (0, pi);
(pi + 1, epi);
] s in
(List.nth ss 0, List.nth ss 1, "")
in
let path = Store.Path.of_string path in
v.Store.write path (string_unescaped value);
v.Store.setperms path (Perms.Node.of_strings (parse_perm perm)) in
try
let lines = file_readlines xs_daemon_database in
List.iter (fun s -> parse_line s) lines
with exc ->
error "caught exn %s" (Printexc.to_string exc)
let write store =
if !enable then
try
let tfile = Printf.sprintf "%s#" xs_daemon_database in
let channel = open_out_gen [ Open_wronly; Open_creat; Open_trunc; ]
0o600 tfile in
Store.dump store channel;
flush channel;
close_out channel;
Unix.rename tfile xs_daemon_database
with exc ->
error "caught exn %s" (Printexc.to_string exc)
|
