87 lines | 3036 chars
| 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 |