aboutsummaryrefslogtreecommitdiffhomepage
path: root/checker/check.ml
diff options
context:
space:
mode:
authorGravatar Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr>2017-11-28 12:51:24 +0100
committerGravatar Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr>2017-11-28 13:34:47 +0100
commit8f47273f118808373649a3a084e4a3c99167edd3 (patch)
tree3a316928b3605cc9f87d6b630a45ccbe9b492152 /checker/check.ml
parentd8093626b49b539bec283285ea37ba50e79f69d4 (diff)
Use safe demarshalling in the checker.
Instead of relying on the OCaml demarshaller, which is not resilient against ill-formed data, we reuse the safe demarshaller from votour. This ensures that garbage files do not trigger memory violations.
Diffstat (limited to 'checker/check.ml')
-rw-r--r--checker/check.ml21
1 files changed, 15 insertions, 6 deletions
diff --git a/checker/check.ml b/checker/check.ml
index 180ca1ece..dfc271995 100644
--- a/checker/check.ml
+++ b/checker/check.ml
@@ -298,18 +298,27 @@ let name_clash_message dir mdir f =
(* Dependency graph *)
let depgraph = ref LibraryMap.empty
+let marshal_in_segment f ch =
+ try
+ let stop = input_binary_int ch in
+ let v = Analyze.instantiate (Analyze.parse_channel ch) in
+ let digest = Digest.input ch in
+ Obj.obj v, stop, digest
+ with _ ->
+ user_err (str "Corrupted file " ++ quote (str f))
+
let intern_from_file (dir, f) =
Flags.if_verbose chk_pp (str"[intern "++str f++str" ...");
let (sd,md,table,opaque_csts,digest) =
try
let ch = System.with_magic_number_check raw_intern_library f in
- let (sd:Cic.summary_disk), _, digest = System.marshal_in_segment f ch in
- let (md:Cic.library_disk), _, digest = System.marshal_in_segment f ch in
- let (opaque_csts:'a option), _, udg = System.marshal_in_segment f ch in
- let (discharging:'a option), _, _ = System.marshal_in_segment f ch in
- let (tasks:'a option), _, _ = System.marshal_in_segment f ch in
+ let (sd:Cic.summary_disk), _, digest = marshal_in_segment f ch in
+ let (md:Cic.library_disk), _, digest = marshal_in_segment f ch in
+ let (opaque_csts:'a option), _, udg = marshal_in_segment f ch in
+ let (discharging:'a option), _, _ = marshal_in_segment f ch in
+ let (tasks:'a option), _, _ = marshal_in_segment f ch in
let (table:Cic.opaque_table), pos, checksum =
- System.marshal_in_segment f ch in
+ marshal_in_segment f ch in
(* Verification of the final checksum *)
let () = close_in ch in
let ch = open_in_bin f in