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_ascii 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