Util.ml 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308
  1. (*
  2. * Copyright (C) 2011-2017 Intel Corporation. All rights reserved.
  3. *
  4. * Redistribution and use in source and binary forms, with or without
  5. * modification, are permitted provided that the following conditions
  6. * are met:
  7. *
  8. * * Redistributions of source code must retain the above copyright
  9. * notice, this list of conditions and the following disclaimer.
  10. * * Redistributions in binary form must reproduce the above copyright
  11. * notice, this list of conditions and the following disclaimer in
  12. * the documentation and/or other materials provided with the
  13. * distribution.
  14. * * Neither the name of Intel Corporation nor the names of its
  15. * contributors may be used to endorse or promote products derived
  16. * from this software without specific prior written permission.
  17. *
  18. * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  19. * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  20. * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  21. * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  22. * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  23. * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  24. * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  25. * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  26. * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  27. * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  28. * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  29. *
  30. *)
  31. open Printf
  32. (* It contains some utility functions. *)
  33. let failwithf fmt = kprintf failwith fmt;;
  34. let splitwith chr = Str.split (Str.regexp_string (Char.escaped chr))
  35. (* For compatibility with F#. *)
  36. let (|>) a f = f a
  37. (* Generate a list of sequent number.
  38. * ----------------------------------
  39. *
  40. * mk_seq 1 0 -> []
  41. * mk_seq 1 1 -> [1]
  42. * mk_seq 1 5 -> [1; 2; 3; 4; 5]
  43. *)
  44. let rec mk_seq from_num to_num =
  45. if from_num > to_num then []
  46. else from_num :: mk_seq (from_num + 1) to_num
  47. (* Return a list without duplicated elements. *)
  48. let dedup_list lst =
  49. let rec do_dedup acc rst =
  50. match rst with
  51. [] -> acc
  52. | h::t -> if List.mem h acc then do_dedup acc t
  53. else do_dedup (h :: acc) t
  54. in do_dedup [] lst
  55. (* Print the usage of this program. *)
  56. let usage (progname: string) =
  57. eprintf "usage: %s [options] <file> ...\n" progname;
  58. eprintf "\n[options]\n\
  59. --search-path <path> Specify the search path of EDL files\n\
  60. --use-prefix Prefix untrusted proxy with Enclave name\n\
  61. --header-only Only generate header files\n\
  62. --untrusted Generate untrusted proxy and bridge\n\
  63. --trusted Generate trusted proxy and bridge\n\
  64. --untrusted-dir <dir> Specify the directory for saving untrusted code\n\
  65. --trusted-dir <dir> Specify the directory for saving trusted code\n\
  66. --help Print this help message\n";
  67. eprintf "\n\
  68. If neither `--untrusted' nor `--trusted' is specified, generate both.\n";
  69. exit 1
  70. (* Command line parsing facilities. *)
  71. type edger8r_params = {
  72. input_files : string list;
  73. use_prefix : bool;
  74. header_only : bool;
  75. gen_untrusted : bool; (* User specified `--untrusted' *)
  76. gen_trusted : bool; (* User specified `--trusted' *)
  77. untrusted_dir : string; (* Directory to save untrusted code *)
  78. trusted_dir : string; (* Directory to save trusted code *)
  79. }
  80. (* The search paths are recored in the array below.
  81. * W/o extra search paths specified, edger8r searchs from current directory.
  82. *)
  83. let search_paths = ref [|"."|]
  84. (* The path separator is usually ':' on Linux and ';' on Windows.
  85. * Concerning that we might compile this code with OCaml on Windows,
  86. * we'd better don't assume that ':' is always used.
  87. *)
  88. let path_separator : char =
  89. match Sys.os_type with
  90. "Win32" -> ';'
  91. | _ -> ':' (* "Unix" or "Cygwin" *)
  92. (* Parse the command line and return a record of `edger8r_params'. *)
  93. let rec parse_cmdline (progname: string) (cmdargs: string list) =
  94. let use_pref = ref false in
  95. let hd_only = ref false in
  96. let untrusted= ref false in
  97. let trusted = ref false in
  98. let u_dir = ref "." in
  99. let t_dir = ref "." in
  100. let files = ref [] in
  101. let rec local_parser (args: string list) =
  102. match args with
  103. [] -> ()
  104. | op :: ops ->
  105. match String.lowercase op with
  106. "--use-prefix" -> use_pref := true; local_parser ops
  107. | "--header-only"-> hd_only := true; local_parser ops
  108. | "--untrusted" -> untrusted := true; local_parser ops
  109. | "--trusted" -> trusted := true; local_parser ops
  110. | "--untrusted-dir" ->
  111. (match ops with
  112. [] -> usage progname
  113. | x::xs -> u_dir := x; local_parser xs)
  114. | "--trusted-dir" ->
  115. (match ops with
  116. [] -> usage progname
  117. | x::xs -> t_dir := x; local_parser xs)
  118. | "--help" -> usage progname
  119. | "--search-path" ->
  120. if ops = [] then usage progname
  121. else
  122. let search_path_str = List.hd ops in
  123. let extra_paths = splitwith path_separator search_path_str in
  124. let extra_path_arry = Array.of_list extra_paths in
  125. search_paths := Array.append extra_path_arry !search_paths;
  126. local_parser (List.tl ops)
  127. | _ -> files := op :: !files; local_parser ops
  128. in
  129. local_parser cmdargs;
  130. let opt =
  131. { input_files = List.rev !files; use_prefix = !use_pref;
  132. header_only = !hd_only; gen_untrusted = true; gen_trusted = true;
  133. untrusted_dir = !u_dir; trusted_dir = !t_dir;
  134. }
  135. in
  136. if !untrusted || !trusted (* User specified '--untrusted' or '--trusted' *)
  137. then { opt with gen_trusted = !trusted; gen_untrusted = !untrusted }
  138. else opt
  139. let separator_str : string = Filename.dir_sep
  140. (* Search the file within given search pathes.
  141. * -------------------------------------------
  142. *
  143. * The second parameter is read from the global variable `search_paths'.
  144. *
  145. * get_file_path "Util.fs" [|"."|] -> "./Ast.fs"
  146. * get_file_path "Util.fs" [|"misc/dir"; "../Edger8r"|] -> "../Edger8r/Ast.fs"
  147. * get_file_path "Util.fs" [|"misc/dir"; "another/dir"|] -> Not_found
  148. *)
  149. let get_file_path (fname: string) =
  150. let get_full_name path =
  151. if Filename.is_relative fname then path ^ separator_str ^ fname
  152. else fname
  153. in
  154. let targets = Array.map get_full_name !search_paths in
  155. let fn_list = Array.to_list targets in
  156. try
  157. List.find Sys.file_exists fn_list
  158. with
  159. Not_found -> failwithf "File not found within search paths: %s\n" fname
  160. (* Get the short name of the given file name.
  161. * ------------------------------------------
  162. *
  163. * get_short_name "Util.fs" -> "Util"
  164. * get_short_name "./Util.fs" -> "Util"
  165. * get_short_name "misc/Util.fs" -> "Util"
  166. *)
  167. let get_short_name (fname: string) =
  168. let bn = Filename.basename fname in
  169. try Filename.chop_extension bn
  170. with Invalid_argument _ -> bn
  171. (* Helper functions that are not contained in OCaml standard library *)
  172. let isdigit = function '0' | '1' .. '9' -> true | _ -> false
  173. let isalpha = function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false
  174. let isalnum c = isdigit c || isalpha c
  175. let str_map f s =
  176. let len = String.length s in
  177. let res = String.create len in
  178. for i = 0 to len - 1 do
  179. String.set res i (f (String.get s i))
  180. done;
  181. res
  182. let str_to_list s =
  183. let rec iter i lst =
  184. if i < 0 then lst else iter (i - 1) (s.[i] :: lst)
  185. in
  186. iter (String.length s - 1) []
  187. let str_forall p s = List.for_all p (str_to_list s)
  188. (* Compute a string that conforms to C identifier.
  189. *
  190. * to_c_identifier "this foo" => "this_foo"
  191. * to_c_identifier "3this" => "_this"
  192. *
  193. * The algorithm is simple, filter invalid characters to `_'.
  194. *)
  195. let to_c_identifier (s: string) =
  196. let convert_char ch =
  197. if isalnum ch then ch else '_'
  198. in
  199. let first_ch =
  200. let ch = s.[0] in
  201. if isalnum ch then ch else '_'
  202. in
  203. let rest_str =
  204. String.sub s 1 (String.length s - 1)
  205. in
  206. Char.escaped first_ch ^ str_map convert_char rest_str
  207. (* Check whether given string is a valid C identifier.
  208. *
  209. * is_c_identifier "this foo" => false
  210. * is_c_identifier "3this" => false
  211. * is_c_identifier "_this" => true
  212. *)
  213. let is_c_identifier(s: string) =
  214. let first_ch = s.[0] in
  215. let rest_str = String.sub s 1 (String.length s - 1) in
  216. if isalpha first_ch || first_ch = '_'
  217. then str_forall (fun ch -> isalnum ch || ch = '_') rest_str
  218. else false
  219. (* ocamlyacc doesn't expose definitions in header section,
  220. * as a quick work-around, we put them here.
  221. *)
  222. let trusted_headers : string list ref = ref []
  223. let untrusted_headers: string list ref = ref []
  224. (* Create directory specified by `d'. *)
  225. let create_dir (d: string) =
  226. let curr_dir = Unix.getcwd () in
  227. (* `get_root_dir' will be called with the head element of a list of
  228. * sub-directories starting from root directory.
  229. * The list will look like -
  230. * ["home", "guest", ...] on Linux, while
  231. * ["c:\\", "Users", ...] on Windows.
  232. *)
  233. let get_root_dir (dirs: string list) =
  234. match Sys.os_type with
  235. "Win32" -> List.hd dirs
  236. | _ -> Filename.dir_sep
  237. in
  238. (* If we have a directory list like ["c:", ...], change the first element
  239. * to "c:\\". Due to the fact that:
  240. * Sys.file_exists "c:" => false
  241. * Sys.file_exists "c:\\" => true
  242. *)
  243. let normalize (ds: string list) =
  244. if Sys.os_type <> "Win32" then ds
  245. else
  246. let d = List.hd ds in
  247. if String.length d = 2 && d.[1] = ':'
  248. then (d ^ Filename.dir_sep) :: List.tl ds
  249. else ds
  250. in
  251. let dir_exist_p dir =
  252. if Sys.file_exists dir then
  253. let stats = Unix.stat dir in
  254. match stats.Unix.st_kind with
  255. | Unix.S_DIR -> true
  256. (* No need handle S_LNK because 'stat' will follow link. *)
  257. | _ -> false
  258. else false
  259. in
  260. let __do_create_and_goto_dir dir =
  261. (if dir_exist_p dir then () else Unix.mkdir dir 0o755);
  262. Unix.chdir dir
  263. in
  264. let do_create_dir () =
  265. let rec do_create_dir_recursively dirs =
  266. match dirs with
  267. [] -> ()
  268. | x::xs ->
  269. __do_create_and_goto_dir x; do_create_dir_recursively xs
  270. in
  271. (* After splitting, we will get a list of all sub-directories.
  272. * "/home/guest/some/path" -> ["home", "guest", "some", "path"];
  273. * "c:\Users\guest\some\path" -> ["c:", "Users", "guest", "some", "path"].
  274. *)
  275. let dirs = normalize (Str.split (Str.regexp separator_str) d) in
  276. let start_dir = if Filename.is_relative d then curr_dir else get_root_dir dirs in
  277. Unix.chdir start_dir;
  278. (* In case of continuous dir_sep in path string, we filter out empty strings. *)
  279. do_create_dir_recursively (List.filter (fun s -> s <> "") dirs);
  280. Unix.chdir curr_dir;
  281. in
  282. try do_create_dir ()
  283. with exn -> (eprintf "error: failed to create directory: `%s'\n" d; exit 1)