|
1 | 1 | open Import
|
2 | 2 |
|
3 |
| -module Sanitizer : sig |
4 |
| - [@@@ocaml.warning "-32"] |
5 |
| - |
6 |
| - module Command : sig |
7 |
| - type t = |
8 |
| - { output : string |
9 |
| - ; build_path_prefix_map : string |
10 |
| - ; script : Path.t |
11 |
| - } |
12 |
| - end |
13 |
| - |
14 |
| - val impl_sanitizer : (Command.t -> string) -> in_channel -> out_channel -> unit |
15 |
| - |
16 |
| - val run_sanitizer |
17 |
| - : ?temp_dir:Path.t |
18 |
| - -> prog:Path.t |
19 |
| - -> argv:string list |
20 |
| - -> Command.t list |
21 |
| - -> string list Fiber.t |
22 |
| -end = struct |
23 |
| - module Command = struct |
24 |
| - type t = |
25 |
| - { output : string |
26 |
| - ; build_path_prefix_map : string |
27 |
| - ; script : Path.t |
28 |
| - } |
29 |
| - |
30 |
| - let of_sexp script (csexp : Sexp.t) : t = |
31 |
| - match csexp with |
32 |
| - | List [ Atom build_path_prefix_map; Atom output ] -> |
33 |
| - { build_path_prefix_map; output; script } |
34 |
| - | _ -> Code_error.raise "Command.of_csexp: invalid csexp" [] |
35 |
| - ;; |
36 |
| - |
37 |
| - let to_sexp { output; build_path_prefix_map; script } : Sexp.t = |
38 |
| - List |
39 |
| - [ Atom build_path_prefix_map |
40 |
| - ; Atom output |
41 |
| - ; Atom (Path.to_absolute_filename script) |
42 |
| - ] |
43 |
| - ;; |
44 |
| - end |
45 |
| - |
46 |
| - let run_sanitizer ?temp_dir ~prog ~argv commands = |
47 |
| - let temp_dir = |
48 |
| - match temp_dir with |
49 |
| - | Some d -> d |
50 |
| - | None -> Temp.create Dir ~prefix:"sanitizer" ~suffix:"unspecified" |
51 |
| - in |
52 |
| - let fname = Path.relative temp_dir in |
53 |
| - let stdout_path = fname "sanitizer.stdout" in |
54 |
| - let stdout_to = Process.Io.file stdout_path Process.Io.Out in |
55 |
| - let stdin_from = |
56 |
| - let path = fname "sanitizer.stdin" in |
57 |
| - let csexp = List.map commands ~f:Command.to_sexp in |
58 |
| - Io.with_file_out ~binary:true path ~f:(fun oc -> |
59 |
| - List.iter csexp ~f:(Csexp.to_channel oc)); |
60 |
| - Process.Io.file path Process.Io.In |
61 |
| - in |
62 |
| - let open Fiber.O in |
63 |
| - let+ () = Process.run ~display:Quiet ~stdin_from ~stdout_to Strict prog argv in |
64 |
| - Io.with_file_in stdout_path ~f:(fun ic -> |
65 |
| - let rec loop acc = |
66 |
| - match Csexp.input_opt ic with |
67 |
| - | Ok None -> List.rev acc |
68 |
| - | Ok (Some (Sexp.Atom s)) -> loop (s :: acc) |
69 |
| - | Error error -> Code_error.raise "invalid csexp" [ "error", String error ] |
70 |
| - | Ok _ -> Code_error.raise "unexpected output" [] |
71 |
| - in |
72 |
| - loop []) |
73 |
| - ;; |
74 |
| - |
75 |
| - let impl_sanitizer f in_ out = |
76 |
| - set_binary_mode_in in_ true; |
77 |
| - set_binary_mode_out out true; |
78 |
| - let rec loop () = |
79 |
| - match Csexp.input_opt in_ with |
80 |
| - | Error error -> Code_error.raise "unable to parse csexp" [ "error", String error ] |
81 |
| - | Ok None -> () |
82 |
| - | Ok (Some sexp) -> |
83 |
| - let command = Command.of_sexp (assert false) sexp in |
84 |
| - Csexp.to_channel out (Atom (f command)); |
85 |
| - flush out; |
86 |
| - loop () |
87 |
| - in |
88 |
| - loop () |
89 |
| - ;; |
90 |
| -end |
91 |
| - |
92 | 3 | (* Translate a path for [sh]. On Windows, [sh] will come from Cygwin so if we
|
93 | 4 | are a real windows program we need to pass the path through [cygpath] *)
|
94 | 5 | let translate_path_for_sh =
|
|
0 commit comments