Package: xml-light / 2.2-17

06_CVE-2012-3514.diff Patch series | download
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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
--- a/dtd.ml
+++ b/dtd.ml
@@ -93,16 +93,18 @@
 
 type dtd = dtd_item list
 
-type ('a,'b) hash = ('a,'b) Hashtbl.t
+module StringMap = Map.Make(String)
+
+type 'a map = 'a StringMap.t ref
 
 type checked = {
-	c_elements : (string,dtd_element_type) hash;
-	c_attribs : (string,(string,(dtd_attr_type * dtd_attr_default)) hash) hash;
+	c_elements : dtd_element_type map;
+	c_attribs : (dtd_attr_type * dtd_attr_default) map map;
 }
 
 type dtd_state = {
-	elements : (string,dtd_element_type) hash;
-	attribs : (string,(string,(dtd_attr_type * dtd_attr_default)) hash) hash;
+	elements : dtd_element_type map;
+	attribs : (dtd_attr_type * dtd_attr_default) map map;
 	mutable current : dtd_element_type;
 	mutable curtag : string;
 	state : (string * dtd_element_type) Stack.t;
@@ -113,7 +115,21 @@
 let _raises e =
 	file_not_found := e
 
-let empty_hash = Hashtbl.create 0
+let create_map() = ref StringMap.empty
+
+let empty_map = create_map()
+
+let find_map m k = StringMap.find k (!m)
+
+let set_map m k v = m := StringMap.add k v (!m)
+
+let unset_map m k = m := StringMap.remove k (!m)
+
+let iter_map f m = StringMap.iter f (!m)
+
+let fold_map f m = StringMap.fold f (!m)
+
+let mem_map m k = StringMap.mem k (!m)
 
 let pos source =
 	let line, lstart, min, max = Xml_lexer.pos source in
@@ -158,45 +174,45 @@
 			raise e
 
 let check dtd =
-	let attribs = Hashtbl.create 0 in
-	let hdone = Hashtbl.create 0 in
-	let htodo = Hashtbl.create 0 in
+	let attribs = create_map () in
+	let hdone = create_map () in
+	let htodo = create_map () in
 	let ftodo tag from =
 		try
-			ignore(Hashtbl.find hdone tag);
+			ignore(find_map hdone tag);
 		with
 			Not_found ->
 				try
-					match Hashtbl.find htodo tag with
-					| None -> Hashtbl.replace htodo tag from
+					match find_map htodo tag with
+					| None -> set_map htodo tag from
 					| Some _ -> ()
 				with
 					Not_found ->
-						Hashtbl.add htodo tag from
+						set_map htodo tag from
 	in
 	let fdone tag edata =
 		try 
-			ignore(Hashtbl.find hdone tag);
+			ignore(find_map hdone tag);
 			raise (Check_error (ElementDefinedTwice tag));
 		with
 			Not_found ->
-				Hashtbl.remove htodo tag;
-				Hashtbl.add hdone tag edata
+				unset_map htodo tag;
+				set_map hdone tag edata
 	in
 	let fattrib tag aname adata =
 		let h = (try
-				Hashtbl.find attribs tag
+				find_map attribs tag
 			with
 				Not_found ->
-					let h = Hashtbl.create 1 in
-					Hashtbl.add attribs tag h;
+					let h = create_map () in
+					set_map attribs tag h;
 					h) in
 		try
-			ignore(Hashtbl.find h aname);
+			ignore(find_map h aname);
 			raise (Check_error (AttributeDefinedTwice (tag,aname)));
 		with
 			Not_found ->
-				Hashtbl.add h aname adata
+				set_map h aname adata
 	in
 	let check_item = function
 		| DTDAttribute (tag,aname,atype,adef) ->
@@ -229,7 +245,7 @@
 			check_type etype
 	in
 	List.iter check_item dtd;
-	Hashtbl.iter (fun t from ->
+	iter_map (fun t from ->
 		match from with
 		| None -> raise (Check_error (ElementNotDeclared t))
 		| Some tag -> raise (Check_error (ElementReferenced (t,tag)))
@@ -248,7 +264,7 @@
 		curtag = "_root";
 	} in
 	try
-		ignore(Hashtbl.find d.elements (String.uppercase root));
+		ignore(find_map d.elements (String.uppercase root));
 		d
 	with
 		Not_found -> raise (Check_error (ElementNotDeclared root))
@@ -365,7 +381,7 @@
 
 let check_attrib ahash (aname,_) =
 	try
-		ignore(Hashtbl.find ahash aname);
+		ignore(find_map ahash aname);
 	with
 		Not_found -> raise (Prove_error (UnexpectedAttribute aname))
 
@@ -378,12 +394,12 @@
 		let uattr = List.map (fun (aname,aval) -> String.uppercase aname , aval) attr in
 		prove_child dtd (Some utag);
 		Stack.push (dtd.curtag,dtd.current) dtd.state;
-		let elt = (try Hashtbl.find dtd.elements utag with Not_found -> raise (Prove_error (UnexpectedTag tag))) in
-		let ahash = (try Hashtbl.find dtd.attribs utag with Not_found -> empty_hash) in
+		let elt = (try find_map dtd.elements utag with Not_found -> raise (Prove_error (UnexpectedTag tag))) in
+		let ahash = (try find_map dtd.attribs utag with Not_found -> empty_map) in
 		dtd.curtag <- tag;
 		dtd.current <- elt;
 		List.iter (check_attrib ahash) uattr;
-		let attr = Hashtbl.fold (prove_attrib dtd uattr) ahash [] in
+		let attr = fold_map (prove_attrib dtd uattr) ahash [] in
 		let childs = ref (List.map (do_prove dtd) childs) in
 		(match dtd.current with
 		| DTDAny