1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
6 (* *)
7 (* Copyright 1996 Institut National de Recherche en Informatique et *)
8 (* en Automatique. *)
9 (* *)
10 (* All rights reserved. This file is distributed under the terms of *)
11 (* the GNU Lesser General Public License version 2.1, with the *)
12 (* special exception on linking described in the file LICENSE. *)
13 (* *)
14 (**************************************************************************)
15
16 (* Print the digests of unit interfaces *)
17
18 open! Dynlink_compilerlibs
19
20 let load_path = ref []
21 let first = ref true
22
23 exception Corrupted_interface
24
25 let digest_interface unit loadpath =
26 let filename =
27 let shortname = unit ^ ".cmi" in
28 try
29 Misc.find_in_path_uncap loadpath shortname
30 with Not_found ->
31 failwith (Printf.sprintf "Cannot find interface %s in load path"
32 shortname)
33 in
34 let ic = open_in_bin filename in
35 try
36 let buffer =
37 really_input_string ic (String.length Config.cmi_magic_number)
38 in
39 if buffer <> Config.cmi_magic_number then begin
40 close_in ic;
41 raise Corrupted_interface
42 end;
43 let cmi = Cmi_format.input_cmi ic in
44 close_in ic;
45 let crc =
46 match cmi.Cmi_format.cmi_crcs with
47 (_, Some crc) :: _ -> crc
48 | _ -> raise Corrupted_interface
49 in
50 crc
51 with End_of_file | Failure _ ->
52 close_in ic;
53 raise Corrupted_interface
54
55 let print_crc unit =
56 try
57 let crc = digest_interface unit (!load_path @ ["."]) in
58 if !first then first := false else print_string ";\n";
59 print_string " \""; print_string (String.capitalize_ascii unit);
60 print_string "\",\n \"";
61 for i = 0 to String.length crc - 1 do
62 Printf.printf "\\%03d" (Char.code crc.[i])
63 done;
64 print_string "\""
65 with exn ->
66 prerr_string "Error while reading the interface for ";
67 prerr_endline unit;
68 begin match exn with
69 Sys_error msg -> prerr_endline msg
70 | Corrupted_interface ->
71 Printf.eprintf "Ill-formed .cmi file (%s)\n" (Printexc.to_string exn)
72 | _ -> raise exn
73 end;
74 exit 2
75
76 let usage = "Usage: extract_crc [-I <dir>] <files>"
77
78 let main () =
79 print_string "let crc_unit_list = [\n";
80 Arg.parse
81 ["-I", Arg.String(fun dir -> load_path := !load_path @ [dir]),
82 "<dir> Add <dir> to the list of include directories"]
83 print_crc usage;
84 print_string "\n]\n"
85
86 let _ = main(); exit 0
87