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		try
87			if not (List.mem_assoc k expected) then
88				other k v
89			else let ty = List.assoc k expected in
90			match ty with
91			| Unit f       -> f ()
92			| Bool f       -> f (bool_of_string v)
93			| String f     -> f v
94			| Int f        -> f (int_of_string v)
95			| Float f      -> f (float_of_string v)
96			| Set_bool r   -> r := (bool_of_string v)
97			| Set_string r -> r := v
98			| Set_int r    -> r := int_of_string v
99			| Set_float r  -> r := (float_of_string v)
100		with
101		| Not_found                 -> append (k, "unknown key")
102		| Failure "int_of_string"   -> append (k, "expect int arg")
103		| Failure "bool_of_string"  -> append (k, "expect bool arg")
104		| Failure "float_of_string" -> append (k, "expect float arg")
105		| exn                       -> append (k, Printexc.to_string exn)
106		) cf;
107	if !err != [] then raise (Error !err)
108
109(** read a filename, parse and validate, and return the errors if any *)
110let read filename expected other =
111	let cf = parse filename in
112	validate cf expected other
113