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 ty =
18  | Set_bool of bool ref
19  | Set_int of int ref
20  | Set_string of string ref
21  | Set_float of float ref
22  | Unit of (unit -> unit)
23  | Bool of (bool -> unit)
24  | Int of (int -> unit)
25  | String of (string -> unit)
26  | Float of (float -> unit)
27
28exception Error of (string * string) list
29
30let trim_start lc s =
31  let len = String.length s and i = ref 0 in
32  while !i < len && (List.mem s.[!i] lc)
33  do
34    incr i
35  done;
36  if !i < len then String.sub s !i (len - !i) else ""
37
38let trim_end lc s =
39  let i = ref (String.length s - 1) in
40  while !i > 0 && (List.mem s.[!i] lc)
41  do
42    decr i
43  done;
44  if !i >= 0 then String.sub s 0 (!i + 1) else ""
45
46let rec split ?limit:(limit=(-1)) c s =
47  let i = try String.index s c with Not_found -> -1 in
48  let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in
49  if i = -1 || nlimit = 0 then
50    [ s ]
51  else
52    let a = String.sub s 0 i
53    and b = String.sub s (i + 1) (String.length s - i - 1) in
54    a :: (split ~limit: nlimit c b)
55
56let parse_line stream =
57  let lc = [ ' '; '\t' ] in
58  let trim_spaces s = trim_end lc (trim_start lc s) in
59  let to_config s =
60    match split ~limit:2 '=' s with
61    | k :: v :: [] -> Some (trim_end lc k, trim_start lc v)
62    | _            -> None in
63  let rec read_filter_line () =
64    try
65      let line = trim_spaces (input_line stream) in
66      if String.length line > 0 && line.[0] <> '#' then
67        match to_config line with
68        | None   -> read_filter_line ()
69        | Some x -> x :: read_filter_line ()
70      else
71        read_filter_line ()
72    with
73      End_of_file -> [] in
74  read_filter_line ()
75
76let parse filename =
77  let stream = open_in filename in
78  let cf = parse_line stream in
79  close_in stream;
80  cf
81
82let validate cf expected other =
83  let err = ref [] in
84  let append x = err := x :: !err in
85  List.iter (fun (k, v) ->
86      let parse ~err_msg parser v f =
87        match parser v with
88        | None -> append (k, err_msg)
89        | Some r -> f r
90      in
91      try
92        if not (List.mem_assoc k expected) then
93          other k v
94        else let ty = List.assoc k expected in
95          match ty with
96          | Unit f       -> f ()
97          | Bool f       -> parse ~err_msg:"expect bool arg" bool_of_string_opt v f
98          | String f     -> f v
99          | Int f        -> parse ~err_msg:"expect int arg" int_of_string_opt v f
100          | Float f      -> parse ~err_msg:"expect float arg" float_of_string_opt v f
101          | Set_bool r   -> parse ~err_msg:"expect bool arg" bool_of_string_opt v (fun x -> r := x)
102          | Set_string r -> r := v
103          | Set_int r    -> parse ~err_msg:"expect int arg" int_of_string_opt v (fun x -> r:= x)
104          | Set_float r  -> parse ~err_msg:"expect float arg" float_of_string_opt v (fun x -> r := x)
105      with
106      | Not_found                 -> append (k, "unknown key")
107      | exn                       -> append (k, Printexc.to_string exn)
108    ) cf;
109  if !err != [] then raise (Error !err)
110
111(** read a filename, parse and validate, and return the errors if any *)
112let read filename expected other =
113  let cf = parse filename in
114  validate cf expected other
115