blob: 6cb3409dd38acbdf1b8d5cb35f415cb653078474 (
plain)
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
|
{
(* Recording key=val bindings *)
let key_val_tbl : (string, string list) Hashtbl.t = Hashtbl.create 17
let key_val key =
try Some(Hashtbl.find key_val_tbl key) with Not_found -> None
(* Auxiliaries for parsing *)
let buf = Buffer.create 32
let stash inword words =
if inword then begin
let w = Buffer.contents buf in
Buffer.clear buf;
w :: words
end else
words
(* Error reporting *)
exception Error of string * int * string
let error msg lexbuf =
Lexing.(raise (Error(lexbuf.lex_curr_p.pos_fname,
lexbuf.lex_curr_p.pos_lnum,
msg)))
let ill_formed_line lexbuf = error "Ill-formed line" lexbuf
let unterminated_quote lexbuf = error "Unterminated quote" lexbuf
let lone_backslash lexbuf = error "Lone \\ (backslash) at end of file" lexbuf
}
let whitespace = [' ' '\t' '\012' '\r']
let newline = '\r'* '\n'
let ident = ['A'-'Z' 'a'-'z' '_'] ['A'-'Z' 'a'-'z' '0'-'9' '_' '.']*
rule begline = parse
| '#' [^ '\n']* ('\n' | eof)
{ Lexing.new_line lexbuf; begline lexbuf }
| whitespace* (ident as key) whitespace* '='
{ let words = unquoted false [] lexbuf in
Hashtbl.add key_val_tbl key (List.rev words);
begline lexbuf }
| eof
{ () }
| _
{ ill_formed_line lexbuf }
and unquoted inword words = parse
| '\n' | eof { Lexing.new_line lexbuf; stash inword words }
| whitespace+ { unquoted false (stash inword words) lexbuf }
| '\\' newline { Lexing.new_line lexbuf; unquoted inword words lexbuf }
| '\\' (_ as c) { Buffer.add_char buf c; unquoted true words lexbuf }
| '\\' eof { lone_backslash lexbuf }
| '\'' { singlequote lexbuf; unquoted true words lexbuf }
| '\"' { doublequote lexbuf; unquoted true words lexbuf }
| _ as c { Buffer.add_char buf c; unquoted true words lexbuf }
and singlequote = parse
| eof { unterminated_quote lexbuf }
| '\'' { () }
| newline { Lexing.new_line lexbuf;
Buffer.add_char buf '\n'; singlequote lexbuf }
| _ as c { Buffer.add_char buf c; singlequote lexbuf }
and doublequote = parse
| eof { unterminated_quote lexbuf }
| '\"' { () }
| '\\' newline { Lexing.new_line lexbuf; doublequote lexbuf }
| '\\' (['$' '`' '\"' '\\'] as c)
{ Buffer.add_char buf c; doublequote lexbuf }
| newline { Lexing.new_line lexbuf;
Buffer.add_char buf '\n'; doublequote lexbuf }
| _ as c { Buffer.add_char buf c; doublequote lexbuf }
{
(* The entry point *)
let read_config_file filename =
let ic = open_in_bin filename in
let lexbuf = Lexing.from_channel ic in
Lexing.(lexbuf.lex_start_p <- {lexbuf.lex_start_p with pos_fname = filename});
try
Hashtbl.clear key_val_tbl;
begline lexbuf;
close_in ic
with x ->
close_in ic; raise x
(* Test harness *)
(*
open Printf
let _ =
Hashtbl.clear key_val_tbl;
begline (Lexing.from_channel stdin);
Hashtbl.iter
(fun key value ->
printf "%s =" key;
List.iter (fun v -> printf " |%s|" v) value;
printf "\n")
key_val_tbl
*)
}
|