Source file oBus_string.ml
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
type t = string
type error = {
typ : string;
str : string;
ofs : int;
msg : string;
}
let typ e = e.typ
let str e = e.str
let ofs e = e.ofs
let msg e = e.msg
type validator = string -> error option
exception Invalid_string of error
let error_message error =
if error.ofs < 0 then
Printf.sprintf "invalid D-Bus %s (%S): %s" error.typ error.str error.msg
else
Printf.sprintf "invalid D-Bus %s (%S), at position %d: %s" error.typ error.str error.ofs error.msg
let () =
Printexc.register_printer
(function
| Invalid_string error ->
Some(error_message error)
| _ ->
None)
let () =
Printexc.register_printer
(function
| Invalid_string error ->
Some(error_message error)
| _ ->
None)
let validate s =
let fail i msg = Some{ typ = "string"; str = s; ofs = i; msg = msg } in
let len = String.length s in
let rec main i =
if i = len then
None
else
let ch = String.unsafe_get s i in
match ch with
| '\x00' ->
fail i "null byte"
| '\x01' .. '\x7f' ->
main (i + 1)
| '\xc0' .. '\xdf' ->
if i + 1 >= len then
fail len "premature end of UTF8 sequence"
else begin
let byte1 = Char.code (String.unsafe_get s (i + 1)) in
if byte1 land 0xc0 != 0x80 then
fail (i + 1) "malformed UTF8 sequence"
else if ((Char.code ch land 0x1f) lsl 6) lor (byte1 land 0x3f) < 0x80 then
fail i "overlong UTF8 sequence"
else
main (i + 2)
end
| '\xe0' .. '\xef' ->
if i + 2 >= len then
fail len "premature end of UTF8 sequence"
else begin
let byte1 = Char.code (String.unsafe_get s (i + 1))
and byte2 = Char.code (String.unsafe_get s (i + 2)) in
if byte1 land 0xc0 != 0x80 then
fail (i + 1) "malformed UTF8 sequence"
else if byte2 land 0xc0 != 0x80 then
fail (i + 2) "malformed UTF8 sequence"
else if ((Char.code ch land 0x0f) lsl 12) lor ((byte1 land 0x3f) lsl 6) lor (byte2 land 0x3f) < 0x800 then
fail i "overlong UTF8 sequence"
else
main (i + 3)
end
| '\xf0' .. '\xf7' ->
if i + 3 >= len then
fail len "premature end of UTF8 sequence"
else begin
let byte1 = Char.code (String.unsafe_get s (i + 1))
and byte2 = Char.code (String.unsafe_get s (i + 2))
and byte3 = Char.code (String.unsafe_get s (i + 3)) in
if byte1 land 0xc0 != 0x80 then
fail (i + 1) "malformed UTF8 sequence"
else if byte2 land 0xc0 != 0x80 then
fail (i + 2) "malformed UTF8 sequence"
else if byte3 land 0xc0 != 0x80 then
fail (i + 3) "malformed UTF8 sequence"
else if ((Char.code ch land 0x0f) lsl 18) lor ((byte1 land 0x3f) lsl 12) lor ((byte2 land 0x3f) lsl 6) lor (byte3 land 0x3f) < 0x10000 then
fail i "overlong UTF8 sequence"
else
main (i + 4)
end
| _ ->
fail i "invalid start of UTF8 sequence"
in
main 0
let assert_validate validator str = match validator str with
| Some error -> raise (Invalid_string error)
| None -> ()